[分享]技巧分享

中国深圳

一，在通用模块键如下内容

Option Compare Database

Option Explicit

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type

二，在选择按钮中键如下代码

Private Sub FileOpen_Click() Dim ofn As OPENFILENAME Dim rtn As String

ofn.lStructSize = Len(ofn) ofn.hwndOwner = Me.hwnd ofn.lpstrFilter = "所有文件 (*.*)" & vbNullChar & "*.*" ofn.lpstrFile = Space(254) ofn.nMaxFile = 255 ofn.lpstrFileTitle = Space(254) ofn.nMaxFileTitle = 255 ofn.lpstrInitialDir = CurrentProject.Path ofn.lpstrTitle = "后台数据文件为" ofn.flags = 6148

rtn = GetOpenFileName(ofn) FileName.SetFocus If rtn = True Then FileName.Text = ofn.lpstrFile FileName.Text = FileName.Text OK.Enabled = True Else FileName.Text = "" ' OK.Enabled = False End If End Sub

'FileName为保存路径的文本框

中国深圳

前几天帮本论坛的会员写了一个软件，因报表要求太高只能把数据输出到EXCEL 中再打印报表。特写了如下代码，现贴出来供需要把ACCESS 中的数据输出到EXCEL 的会员参考。

Private Sub Command0_Click() Dim rs As ADODB.Recordset Dim I As Integer Dim xlApp As Excel.Application Dim xlBook As Workbook, xlSheet As Worksheet

Set rs = New ADODB.Recordset

Set xlApp = CreateObject("Excel.Application") Set xlApp = New Excel.Application Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\acc.XLS") '打开要输出的EXECL文件 Set xlSheet = xlBook.Worksheets(1) '打开工作表,这里是第一个,可以设其他 xlApp.Visible = True '显示

rs.Open "TBL_现金日报表", CurrentProject.Connection, 3, 3

If Not rs.EOF Then rs.MoveFirst

Do While Not rs.EOF I = I + 1 For x = 0 To 2

xlSheet.Cells(I, x + 1) = rs(x) 'CELLS(行,列) 单元格 Next x rs.MoveNext Loop rs.Close 'xlSheet.PrintPreview '如果是要打印，只要把 PrintPreview 改为 PrintOut 'xlBook.Close SaveChanges:=False 'xlApp.Quit '退出

End Sub

中国深圳

Public Sub Ziduantf(FrmName) '功能说明:我们开发的软件在实际应用中,有些字段是必须输入的.而用户可能会因为操作上的原因,发生漏输入的现象 ' 这个函数可以控制用户必须输入合法数据. '使用说明:首先需要在窗体必输控件的"控件提示文本"属性中填入"必填字段",FrmName 参数是当前操作的窗体名称. '作者: 中国人 '日期:2005-09-01 On Error GoTo Ziduantf_err Dim Ctl As Control For Each Ctl In Forms(FrmName).Controls If Ctl.ControlType = acComboBox Or Ctl.ControlType = acTextBox Or Ctl.ControlType = acCheckBox Then If Ctl.ControlTipText = "必填字段" And IsNull(Ctl) = True Then Ctl.SetFocus MsgBox "请输入" & Ctl.Name & "", 64, "系统提示" Exit For End If End If Next Ziduantf_exit: Exit Sub Ziduantf_err: Resume Next End Sub

angel2004

请求：想你提示我如何做一个用户登录界面

中国深圳

以下是引用angel2004在2005-10-26 17:21:11的发言：

请求：想你提示我如何做一个用户登录界面

在Q群的共享中有示例下载。

angel2004

谢谢，学习中......

[em06]

中国深圳

应朋友的要求，做个更改主窗口背景色的示例 rpTZplI6.rar (28.6 KB, 下载次数: 22)

2005-12-14 16:55 上传

点击文件名下载附件
[分享]技巧分享

详情请访问 http://www.accessbbs.ful.cn

wx-x

以下是引用[I]中国深圳[/I]在2005-6-25 11:30:22的发言：[BR]

IF 如果本贴所列技巧可以对你的工作或学习有所帮助 Then

Msgbox "那将是俺引以为荣的事情"

Elseif 如果你可以把自己的技巧拿出来分享 Then

Msgbox " 这是俺最高兴看到的事"

Else

Msgbox "为了保持贴子的可读性，请不要灌水，谢谢！"

End if

高手。

wwwwa

thanks

goodnightzh

好啊,又学到一点东东了