清空表记录的
以下为需要花5金钱才能购买并浏览的内容,您已经购买本贴
1、CurrentDb().Execute "delete * from 表名"
2、docmd.runsql "SQL语句"
窗体真正居中显示
窗体真正居中显示
如下代码可以做到真正居中显示
Private Sub Form_Load()
DoCmd.Echo False
Dim x, y As Integer
DoCmd.Maximize
x = Me.WindowWidth
y = Me.WindowHeight
DoCmd.Restore
DoCmd.Echo True
Move (x - Me.WindowWidth) / 2, (y - Me.WindowHeight) / 2
End Sub
把子窗体的内容复制到EXCEL[转帖]
来源
HYPERLINK "http://www.accessqq.com" \t "_blank" www.accessqq.com
原作者: 黄海
Sub 把子窗体的内容复制到EXCEL()
Me.Child28.SetFocus '把焦点移动子窗体上 Child28要操作的子窗体的名称
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
Dim obj As Object
Set obj = CreateObject("excel.application")
obj.Workbooks.Add
obj.Visible = True
SendKeys "^v"
End Sub
获得窗体/焦点控件信息
来源:ACCESS中国 浪上飞郑
'用screen,下面为帮助里的原代码,还是帮助好用
Sub ActiveObjects()
Dim frm As Form, ctl As Control
' 返回指向活动窗体的 Form 对象。
Set frm = Screen.ActiveForm
MsgBox frm.Name & " is the active form."
' 返回指向活动控件的 Control 对象。
Set ctl = Screen.ActiveControl
MsgBox ctl.Name & " is the active control " _
& "on this form."
End Sub
打开窗体后进入新增模式
Opening a Form at a new Record
There are a couple of ways, depending on how you want your input forms to behave after they've been opened. If you only want to enter records, then in the code to open the form, put this code:
DoCmd.OpenForm "frmName", acNormal, ,acFormAdd
If you want to be able to navigate to other records in the form, then put the following code in the OnLoad event for the form:
Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
End Sub
检查数据是否被修改,无则退出,有则询问是否保存
来源:ACCESS交流中心 fatmingli
'在窗体的字段的“属性”“事件”“更新后”的右边输入“=NoAllowSave()”,
'在窗体的“打开”事件中代码“allowSave = False”
'定义模块
Option Compare Database
Option Explicit
Public allowSave As Boolean
Public Function NoAllowSave()
allowSave = True
End Function
“退出”按钮的单击事件代码
If allowSave = True Then
If MsgBox("当前数据已经被修改,是否保存?", vbYesNo + vbQuestion, "请选择...") = vbYes Then
Else
Me.Undo
End If
End If
DoCmd.Close
让access系统窗口的最大化、最小化消失的代码
'新建一个模块。
'在建立一个autoexec宏,“操作”为runcode,参数:启动 ()
'最大化和最小化消失了!
'api声明:
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
'===============================
'获得活动窗口的句柄
'Declare Function GetActiveWindow Lib "user32" () As Long
'===================
'改变窗体大小
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'使用:
Sub 最大化和最小化按钮消失()
Dim lWnd As Long
lWnd = GetWindowLong(Application.hWndAccessApp, GWL_STYLE)
lWnd = lWnd And Not (WS_MINIMIZEBOX)'最小化
lWnd = lWnd And Not (WS_MAXIMIZEBOX)‘最大化
lWnd = SetWindowLong(Application.hWndAccessApp, GWL_STYLE, lWnd)
End Sub
Public Function 改变窗体大小()
'Application.hWndAccessApp 当前程序的.hwnd
Call 最大化和最小化按钮消失
MoveWindow Application.hWndAccessApp, 20, 20, 600, 400, 1
End Function
窗体上以打字效果显示字符
窗体上以打字效果显示字符
窗体上以打字效果显示字符
来源:不祥
Dim myStr As String
Dim myStrLen As Integer
Dim i As Integer
Private Sub Form_Load()
i = 1
myStr = "同仇敌忾,对抗非典!" '"输入需打字的内容"
Me.TimerInterval = 300
End Sub
Private Sub Form_Timer()
myStrLen = Len(myStr)
If i > myStrLen Then
标签0.Caption = ""
Else
标签0.Caption = Mid(myStr, 1, i)
End If
'控制循环显示
If i <= myStrLen Then
i = i + 1
Else
i = 1
End If
End Sub
其实这样也可以:
Dim myStr As String
Dim myStrLen As Integer
Dim i As Integer
Private Sub Form_Load()
i = 1
myStr = "同仇敌忾,对抗非典!"
Me.TimerInterval = 300
End Sub
Private Sub Form_Timer()
myStrLen = Len(myStr)
If i > myStrLen Then
标签0.Caption = ""
i = 1
Else
标签0.Caption = Mid$(myStr, 1, i)
i = i + 1
End If
End Sub
让字符走动
Dim strwelcometo As String
Private Sub Form_Load()
Me.TimerInterval = 100
strwelcometo = "欢迎使用大通国际运输有限公司发票管理系统 "
Me!WellcomeTo.Caption = strwelcometo
End Sub
Private Sub Form_Timer()
Me!WellcomeTo.Caption = Right(strwelcometo, Len(strwelcometo) - 1) & Left(strwelcometo, 1)
strwelcometo = Me!WellcomeTo.Caption
End Sub
让窗体10秒钟自动翻页:
Private Sub Form_Load()
Me.TimerInterval = 1000
End Sub
Private Sub Form_Timer()
Static I As Long
I = I + 1
If I = 10 Then
Call 命令6_Click
I = 0
End If
End Sub
Private Sub 命令6_Click()
On Error GoTo Err_命令6_Click
DoCmd.GoToRecord , , acNext
Exit_命令6_Click:
Exit Sub
Err_命令6_Click:
DoCmd.GoToRecord , , acFirst
Resume Exit_命令6_Click
End Sub
显示的当前记录的记录号
[CurrentRecord]用于显示的当前记录的记录号。
判断记录的位置
来自:ACCESS中国 ysf
me.Recordset.AbsolutePosition = 0 '第一条记录
me.Recordset.AbsolutePosition = me.Recordset.RecordCount -1 '最后一条记录
me.Recordset.AbsolutePosition=-1 '第一条记录前 me.Recordset.bof=true
me.Recordset.AbsolutePosition=me.Recordset.RecordCount '最后一条记录后 me.Recordset.eof=true
me.Recordset.AbsolutePosition=n '第n+1条记录
原创]只显示窗体内容,不显示菜单栏、常用工具栏
'将窗体设为 弹出方式 设为"是"
Private Sub Form_Load()
docmd.RunCommand acCmdAppMinimize
end sub
分享]窗体内的控件与窗体大小同步变化!
本示例作者是谁,不记得了,不过试过后很实用的;有一点,只记得原码是加密的,还请各位版主不要
!
一:建一模块
Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularh鰄e As Long)
Dim CHANGE_FACTOR As Double
Dim CHANGE_CONTROL As Control
If Not Formular.WindowWidth = 0 Then
CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite
If Not CHANGE_FACTOR = 1 Then
On Error Resume Next
If CHANGE_FACTOR > 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If
For Each CHANGE_CONTROL In Formular.Controls
If CHANGE_CONTROL.ControlType = acSubform Then
Dim UFOBREITE As Integer
Dim UFOHREITE As Integer
UFOBREITE = CHANGE_CONTROL.Width
UFOHREITE = CHANGE_CONTROL.Height
CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHREITE
Else
CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
CHANGE_CONTROL.FontSize = CHANGE_CONTROL.FontSize * CHANGE_FACTOR
End If
Next
If CHANGE_FACTOR < 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If
Formular.Repaint
On Error GoTo 0
End If
End If
End Sub
二、应用:
Option Compare Database
Option Explicit
Dim Form_Start_Height As Long
Dim Form_Start_Width As Long
Dim Form_Current_Height As Long
Dim Form_Current_Width As Long
Private Sub Form_Open(Cancel As Integer)
Form_Start_Height = Me.WindowHeight
Form_Start_Width = Me.WindowWidth
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth
End Sub
Private Sub Form_Resize()
ResizeControls Me, Form_Current_Width, Form_Current_Height
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth
End Sub
对话框返回文本框内容
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
InputBox 函数的语法具有以下几个命名参数:
Prompt:必需的。作为对话框消息出现的字符串表达式。prompt 的最大长度大约是 1024 个字符,由所用字符的宽度决定。如果 prompt 包含多个行,则可在各行之间用回车符 (Chr(13))、换行符 (Chr(10)) 或回车换行符的组合 (Chr(13) & Chr(10)) 来分隔。
Title:可选的。显示对话框标题栏中的字符串表达式。如果省略 title,则把应用程序名放入标题栏中。
Default:可选的。显示文本框中的字符串表达式,在没有其它输入时作为缺省值。如果省略 default,则文本框为空。
Xpos:可选的。数值表达式,成对出现,指定对话框的左边与屏幕左边的水平距离。如果省略 xpos,则对话框会在水平方向居中。
Ypos:可选的。数值表达式,成对出现,指定对话框的上边与屏幕上边的距离。如果省略 ypos,则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。
Helpfile:可选的。字符串表达式,识别帮助文件,用该文件为对话框提供上下文相关的帮助。如果已提供 helpfile,则也必须提供 context。
Context: 可选的。数值表达式,由帮助文件的作者指定给某个帮助主题的帮助上下文编号。如果已提供 context,则也必须要提供 helpfile。
示例:
本示例说明使用 InputBox 函数来显示用户输入数据的不同用法。如果省略 x 及 y 坐标值,则会自动将对话框放置在两个坐标的正中。如果用户单击“确定”按钮或按下“ENTER”按键,则变量 Myvalue 保存用户输入的数据。如果用户单击“取消”按钮,则返回一零长度字符串。
Dim Message, Title, Default, Myvalue
Message = "Enter a value between 1 and 3" ' 设置提示信息。
Title = "InputBox Demo" ' 设置标题。
Default = "1" ' 设置缺省值。
' 显示信息、标题及缺省值。
Myvalue = InputBox(Message, Title, Default)
' 使用帮助文件及上下文。“帮助”按钮便会自动出现。
Myvalue = InputBox(Message, Title, , , , "DEMO.HLP", 10)
' 在 100, 100 的位置显示对话框。
Myvalue = InputBox(Message, Title, Default, 100, 100)
用代码使ACCESS主窗体上的“X”失效
来源:Alex
曾经有人问过这个问题,是为了防止用户不按正常程序退出。
在程序开始的窗体里加入:
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Sub FORM_Load()
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060
Dim hMenu As Long
hMenu = GetSystemMenu(Application.hWndAccessApp, 0)
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
End Sub
在ACCESS 2000中通过测试,97和XP没有测试过。
[原创]根据屏幕分辨率自动调整窗体大小:[
Option Compare Database
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Sub Form_Open(Cancel As Integer)
Dim x As Long, y As Long, a As Long, b As Long
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
a = 10000 / 800 * x
b = 7000 / 600 * y
DoCmd.MoveSize 1134, 1134, a, b
End Sub
窗口增加时钟
窗口增加时钟
***************** Code Start ***************
Private Sub Form_Timer()
Me!lblClock.Caption = Format(Now, "dddd, mmm d yyyy, hh:mm:ss AMPM")
End Sub
Private Sub cmdClockStart_Click()
Me.TimerInterval = 1000
End Sub
Private Sub cmdClockEnd_Click()
Me.TimerInterval = 0
End Sub
在一个窗体中刷新另一个窗体中的控件代码
Forms!窗体名.Form.控件名.Requery
变更窗体图标
来源:tehthspace.accxp.com
Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, _
ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, _
ByVal un2 As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_SETICON = &H80
Const IMAGE_ICON = 1
Const LR_LOADFROMFILE = &H10
Function SetFormIcon(hwnd As Long, IconPath As String) As Boolean
On Error GoTo Exit_ERR
Dim hIcon As Long
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
If hIcon <> 0 Then
Call SendMessage(hwnd, WM_SETICON, 0, ByVal hIcon)
SetFormIcon = True
Else
End
End If
Exit_ERR:
Exit Function
End Function
如何让窗体大小固定(不用弹出窗体,不影响其他窗体)
来源:爱赛思应用俱乐部 tanyiqiang
用 对话框 边框。
在一个窗体中执行另一窗体的子程序
来源:爱赛思应用俱乐部 huanghai
DoCmd.OpenForm "窗体2"
Call Forms("窗体2").aaa
用其他ACCESS的表作为本ACCESS 窗体的数据源
来源:ACCESS中国 Trynew
在Sql语句中的表名前加上数据库名就行了,下面语句动态引用当前目录的另一MDB文件的表做数据源:
Private Sub Form_Load()
Me.RecordSource = "SELECT 表1.* FROM [" & CurrentProject.Path & "\db1.mdb" & "].表1;"
End Sub
让窗体在几秒钟自动打开.
Private Sub Form_Open(Cancel As Integer)
Me.TimerInterval = 5000
End Sub
Private Sub Form_Timer()
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm ("主切换面板")
End Sub
两个子窗体记录根据记录号同步移动的一个方法
原创:Trynew
子窗体1与子窗体2的记录以1:2的步长移动,
把下列代码分别添加到子窗体模块中:
Subform1:
Private Sub Form_Current()
On Error Resume Next
If Me.Parent.ActiveControl.Name = Me.Name Then
Me.Parent.subform2.Form.Recordset.Move Me.CurrentRecord * 2 - 1 - Me.Parent.subform2.Form.CurrentRecord
End If
End Sub
Subform2
Private Sub Form_Current()
On Error Resume Next
If Me.Parent.ActiveControl.Name = Me.Name Then
Me.Parent.Subform1.Form.Recordset.Move (Me.CurrentRecord + 1) \ 2 - Me.Parent.Subform1.Form.CurrentRecord
End If
End Sub
用代码隐藏、最大化、最小化ACCESS的主窗口
怎样用代码隐藏、最大化、最小化ACCESS的主窗口
作 者:朱亦文(译)
摘 要:该函数能用来完全隐藏 Access 窗口并将你自己的窗体显示在桌面上。在弹出式窗体的 Open 事件中使用 SW_HIDE 参数调用 fSetAccessWindow 函数实现。
正 文:
(问) 怎样用代码隐藏、最大化、最小化ACCESS的主窗口?
(答) 通过一函数已定义的常量 fSetAccessWindow 实现。
该函数能用来完全隐藏 Access 窗口并将你自己的窗体显示在桌面上。在弹出式窗体的 Open 事件中使用 SW_HIDE 参数调用 fSetAccessWindow 函数实现。
注意:如果你隐藏了 Access 主窗口,要确定你有良好的出错处理。因为主窗口隐藏后,一旦引发错误,并出错提示窗口上点击了“结束”按钮,这样不会使 Access 主窗口可见,并退出你自己的窗体。推荐你在你的错误处理程序中使用 SW_SHOWNORMAL 参数调用 fSetAccessWindow 函数来显示 Access 主窗口。
如果由于别的原因,Access 主窗口不能显示,那么你将只能从任务栏中关闭你的 mdb,在 Win 9x 中使用 Control-Alt-Delete 来结束任务,在 Win NT 、2000 或 XP 中,可以右键单击任务栏选择任务管理器来选择该 mdb 结束任务。
'************ 代码开始 **********
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Function fSetAccessWindow(nCmdShow As Long)
' 使用举例
' 最大化 Access 窗口
' ?fSetAccessWindow(SW_SHOWMAXIMIZED)
' 最小化 Access 窗口
' ?fSetAccessWindow(SW_SHOWMINIMIZED)
' 隐藏 Access 窗口
' ?fSetAccessWindow(SW_HIDE)
' 正常显示 Access 窗口
' ?fSetAccessWindow(SW_SHOWNORMAL)
'
Dim loX As Long
Dim loFORM As FORM
On Error Resume Next
Set loFORM = Screen.ActiveFORM
If Err <> 0 Then ' 没有活动窗体 no ActiveFORM
If nCmdShow = SW_HIDE Then
MsgBox "除非屏幕上有一个窗口,否则不能隐藏 Access 主窗口!" _
& vbcr & vbcr _
& "Cannot hide Access unless " _
& "a FORM is on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
Else
If nCmdShow = SW_SHOWMINIMIZED And loFORM.Modal = True Then
MsgBox "不能由屏幕上的 " & (loFORM.Caption + " ") & "窗体最小化 Access 主窗口!" _
& vbcr & vbcr _
& "Cannot minimize Access with " _
& (loFORM.Caption + " ") _
& "FORM on screen"
ElseIf nCmdShow = SW_HIDE And loFORM.PopUp <> True Then
MsgBox "不能由屏幕上的 " & (loFORM.Caption + " ") & "窗体隐藏 Access 主窗口!" _
& vbcr & vbcr _
& "Cannot hide Access with " _
& (loFORM.Caption + " ") _
& "FORM on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
End If
fSetAccessWindow = (loX <> 0)
End Function
恢复默认菜单和工具栏的
作者:朱亦文
恢复默认菜单和工具栏的办法
引用 microsoft office 9.0 object library
执行如下过程:
public sub enabledefaultmenu()
dim obar as commandbar
set obar = commandbars("menu bar")
obar.reset
end sub
恢复默认菜单和工具栏,搞定!
注:menu bar是指access的主菜单
隐藏当前激活的工具条
Dim dqgjt As Variant
Set dqgjt = CommandBars.ActiveMenuBar
dqgjt.Enabled = False
判断窗体是否打开的两种方法
判断窗体是否打开的两种方法
判断窗体是否打开的两种方法
Function IsLoaded(strName As String, Optional intObjectType As Integer =
acForm)
IsLoaded = (SysCmd(acSysCmdGetObjectState, intObjectType, strName) <> 0)
End Function
函数二
Function IsFormLoaded(strFrmName As String) As Boolean
Const conFormDesign = 0
Dim intX As Integer
IsFormLoaded= False
For intX = 0 To Forms.Count - 1
If Forms(intX).FormName = strFrmName Then
If Forms(intX).CurrentView <> conFormDesign Then
IsFormLoaded= True
Exit Function ' Quit function once form has been found.
End If
End If
Next
更新数据时保存提示操作员
更新数据时保存提示操作员
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim strMsg As String
strMsg = "Data has changed."
strMsg = strMsg & "@Do you wish to save the changes?"
strMsg = strMsg & "@Click Yes to Save or No to Discard changes."
If MsgBox(strMsg, vbQuestion + vbYesNo, "Save Record?") = vbYes Then
'do nothing
Else
DoCmd.RunCommand acCmdUndo
'For Access 95, use DoMenuItem instead
'DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
End If
End Sub
‘子窗口无数据时,隐藏
'*********** Code Start **********
Private Sub Form_Current()
With Me![SubformName].Form
.Visible = (.RecordsetClone.RecordCount > 0)
End With
End Sub
制窗体的垂直滚动条的显示与否的代码
控制窗体的垂直滚动条的显示与否的代码
来源:ACCESS 中国 李寻欢
不显示:Me.ScrollBars = 0
全部显示:Me.ScrollBars = 3
显示水平:Me.ScrollBars = 1
显示垂直:Me.ScrollBars = 2
打开与关闭窗体的函数
打开与关闭窗体的函数
将一些常用命令写成函数,以简化您的程序
如关闭窗体指令可将之写成以下形式放在模块中
Function strCloseForm(strFormName As String) As String
On Error GoTo strCloseForm_Err
DoCmd.Close acForm, strFormName
strCloseForm_Exit:
Exit Function
strCloseForm_Err:
MsgBox Error$
Resume strCloseForm_Exit
End Function
调用方法:关闭本窗体 strCloseForm(Me.Name)
关闭其它窗体 strCloseForm("FormName")
如何取两个文本框中的最大值
如何取两个文本框中的最大值
本站原创:
问:
在窗体中,同一个记录里有两个字段是数值,新增一个文本框,文本框的值是两个字段中的最大值,那么该文本框的函数该怎样设置?
如:
字段 A B
值 10 8
新增字段 C ,那么C字段在该记录中的值就是10,如何设置C字段文本框?
答:C=iif(A>B,A,B)'意思是如果A>B,则C=A,否则C=B
隐藏主窗口
隐藏主窗口
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
' 使用举例
' 最大化 Access 窗口
' ?fSetAccessWindow(SW_SHOWMAXIMIZED)
' 最小化 Access 窗口
' ?fSetAccessWindow(SW_SHOWMINIMIZED)
' 隐藏 Access 窗口
' ?fSetAccessWindow(SW_HIDE)
' 正常显示 Access 窗口
' ?fSetAccessWindow(SW_SHOWNORMAL)
'
Option Compare Database
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Function fSetAccessWindow(nCmdShow As Long)
Dim loX As Long
Dim loForm As Form
On Error Resume Next
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
fSetAccessWindow = (loX <> 0)
End Function
Private Sub Form_Load()
Dim yhsfm As String
yhsfm = CurrentUser()
If yhsfm <> "ylw" Then
Dim X
X = fSetAccessWindow(0)
End If
End sub
如何设置窗体左上角的图标?
如何设置窗体左上角的图标?
方法很多,这里介绍3种:
方法一:
在菜单中设置, 工具 -> 启动 -> 应用程序图标
如果在“用作窗体和报表的图标”前面打勾,那么你的这个access数据库中所有的窗体和报表的图标都会一致
方法二:
用api,代码如下:
There are no direct way to place a custom icon in a form's caption bar. However, by loading an ICO file into memory, we can assign the icon to a form by sending a WM_SETICON message to the window.
'*********** Code Start ********
'Code courtesy of
'Klaus H. Probst
'
'// Place all this in a module
Public Declare Function LoadImage Lib "user32" _
Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) _
As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
LParam As Any) _
As Long
Public Const WM_GETICON = &H7F
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const ICON_BIG = 1
'// LoadImage() image types
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3
'// LoadImage() flags
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000
Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean
Dim hIcon As Long
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
'// wParam = 0; Setting small icon. wParam = 1; setting large icon
If hIcon <> 0 Then
Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon)
SetFormIcon = True
End If
End Function
'*********** Code Start ********
'翻译成中文如下:
没有一个直接的办法为窗体设置自己的图标,然而, 通过加载图标文件到内存,
然后通过发送WM_SETICON 消息到这个窗体来指定这个窗体的图标
'*********** 代码开始 ********
'Code courtesy of
'Klaus H. Probst
'
'// 引用API 函数loadimage及 sendmessage
Public Declare Function LoadImage Lib "user32" _
Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) _
As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
LParam As Any) _
As Long
Public Const WM_GETICON = &H7F
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const ICON_BIG = 1
'// LoadImage() image types
'指定了欲载入的图象类型:IMAGE_BITMAP, IMAGE_CURSOR, IMAGE_ICON
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3
'// LoadImage() 参数
'LR_DEFAULTCOLOR 以常规方式载入图象
'LR_LOADREALSIZE 不对图象进行缩放处理。忽略n1和n2的设置
'LR_CREATEDIBSECTION 如果指定了IMAGE_BITMAP,就返回DIBSection的句柄,而不是位图
的句柄
'LR_DEFAULTSIZE 如果n1和n2为零,就使用由系统定义的图象默认大小,而不是图象本身
定义的大小
'LR_LOADFROMFILE 如hInst为零,lpsz就代表要载入适当类型的一个文件的名字,仅适用
于Win95
'LR_LOADMAP3DCOLORS 将图象中的深灰、灰、以及浅灰像素都替换成COLOR_3DSHADOW,
COLOR_3DFACE以及COLOR_3DLIGHT的当前设置
'LR_LOADTRANSPARENT 与图象中第一个像素相符的所有像素都由系统替换
'LR_MONOCHROME 将图象转换成单色
'LR_SHARED 将图象作为一个共享资源载入。在NT 4.0中装载固有资源时要用到这个设置
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000
Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean
Dim hIcon As Long
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
'载入一个位图、图标或指针 (上面使用小图标)
'返回值 执行成功则返回对象的一个句柄;零表示失败
If hIcon <> 0 Then '如果成功则设置窗体图标
Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon) '设置窗体图标
SetFormIcon = True '返回设置成功
End If
End Function
'*********** 代码结束 ********
方法三:
Access本身有代码可以定义
先定义以下函数:
Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo AddProp_Err
dbs.Properties(strName) = varvalue
AddAppProperty = True
AddProp_Bye:
Exit Function
AddProp_Err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, varType, varvalue)
dbs.Properties.append prp
Resume
Else
AddAppProperty = False
Resume AddProp_Bye
End If
End Function
然后用以下语句调用
AddAppProperty "AppIcon", DB_Text, Application.CurrentProject.Path & "\icon.ICO"
方法四:
在ACCESS中没有一个直接的办法为窗体设置自己的图标,但是, 可以通过Wondows API的LoadImage加载图标文件到内存, 通过SendMessage发送WM_SETICON消息到这个窗体,来指定这个窗体的图标。
首先新建一个模块,添加Windows API函数定义如下:
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) _
As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
LParam As Any) _
As Long
定义API要使用的常量如下:
Public Const WM_SETICON = &H80
Public Const IMAGE_ICON = 1
Public Const LR_LOADFROMFILE = &H10
更改窗体图标的函数
Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean
' 调用方式
' 例: intX = SetFormIcon(Me.hWnd, strPicPath)
Dim hIcon As Long
' 加载 16X16 图标到内存
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
' 返回值 执行成功则返回对象的一个句柄;零表示失败
If hIcon <> 0 Then '如果成功则设置窗体图标
' 发送消息,设置窗体图
Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon)标
SetFormIcon = True '返回设置成功
Else
SetFormIcon = False
End If
End Function
在程序中使用
例如:把当前窗体的图标改 C:\my.ico
一般在窗体的加载事件处理程序中书写更改窗体的程序
Private Sub Form_Load()
Dim intX
intX = SetFormIcon(Me.hWnd, "C:\my.ico")
End Sub
让获得焦点的字段自动改变背景颜色
让获得焦点的字段自动改变背景颜色
如果你的控件是文本框,名称为“txt字段”,写如下代码:
Private Sub txt字段_GotFocus()
Me.txt字段.BackColor = 12632256
End Sub
当中“12632256”是灰色,你可以自己选择希望的颜色,如果想在失去焦点时改为原来的颜色,写如下代码:
Private Sub txt字段_LostFocus()
Me.txt字段.BackColor = 16777215
End Sub
窗体上所有控件的输入法关掉!
窗体上所有控件的输入法关掉!
将窗体上所有控件的输入法关掉!
来源:不祥
Private Sub Form_Open(Cancel As Integer)
Dim ctl As Access.Control
For Each ctl In Me.Controls
Debug.Print ctl.Name & ctl.ControlType
If ctl.ControlType = acTextBox Then
ctl.IMEMode = 2
End If
Next
End Sub
上述代码控制文本框,你还可以控制其他的,只要copy进窗体就可以了
常量 控件
acBoundObjectFrame 绑定对象框
acCheckBox 复选框
acComboBox 组合框
acCommandButton 命令按钮
acCustomControl ActiveX(自定义)控件
acImage 图像
acLabel 标签
acLine 线条
acListBox 列表框
acObjectFrame 未绑定对象框或图表
acOptionButton 选项按钮
acOptionGroup 选项组
acPage 页
acPageBreak 分页符
acRectangle 矩形
acSubform 子窗体/子报表
acTabCtl 选项卡
acTextBox 文本框
acToggleButton 切换按钮
设置ListBox的水平卷动轴的宽度
设置ListBox的水平卷动轴的宽度
如何设置ListBox的水平卷动轴的宽度?
' API函数声明
Const LB_SETHORIZONTALEXTENT = &H194
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long
' 调用
Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, 400, ByVal 0&)
' 注意400是以象素为单位,你可以根据情况自行设定。
如何使你的标签闪烁以引人注意
如何使你的标签闪烁以引人注意
来源:ACCESS中国 tmtony
设置窗体的TimerInterval 值为1000 (1秒).
forms OnTimer 加入代码:
Sub Form_Timer()
YourTextLabel.Visible = Not YourTextLabel.Visible
End_Sub
窗体无数据自动关闭
窗体无数据自动关闭
来源:爱赛思应用俱乐部 tanyiqiang
Private Sub FORM_Open(Cancel As Integer)
If Me.Recordset.RecordCount = 0 Then
Cancel = True
End If
End Sub
怎样使窗体一打开就定位到指定记录上
怎样使窗体一打开就定位到指定记录上
定义一个变量lngbh,要窗体打开时显示ID=Lngbh的这条记录。
DoCmd.OpenForm "formname", acNormal, , "ID =" & LNGBH, acFormEdit, acWindowNormal
如何在ACCESS之窗体中删除记录,但显示自订对话框?
如何在ACCESS之窗体中删除记录,但显示自订对话框?
来源:ACCESS交流中心 huang59
一般在ACCESS内删除记录时,ACCESS会显示预设对话框,确认删除动作,若要显示自订对话框,可在窗体之BeforeDelConfirm事件程序拦截删除动作,BeforeDelConfirm事件程序提供两个参数,Response表示如何控制预设对话框,acDataErrContinue表示不显示预设对话框,若Response= acDataErrDisplay,则表示显示预设对话框,Cancel=True则表示中止删除动作,也就不删除,因使用者已按下「否」按钮。若按下「是」按钮,则会继续发生AfterDelConfirm事件,同时删除记录。
TextBox 限制只能输入数字
TextBox 限制只能输入数字
来源:老怪
Private Sub Text1_KeyPress(KeyAscii As Integer)
'KeyAscii 32 以下是一些控制键,拦接会造成操作障碍
If KeyAscii >= 33 Then
If KeyAscii <= vbKey9 And KeyAscii>= vbKey0 Then
Else
'把 KeyAscii 設為 0 就是取消輸入
KeyAscii = 0
MsgBox "不可輸入非數字字元"
End If
End If
End Sub
解說:
KeyAscii 之键码同於 KeyCode 之鍵碼,你可以查 VB 說明之 KeyCode 一項,但有些Keycode 鍵碼一定要在 KeyDown 和 KeyUp 裏才收的到,在 KeyPress 的 KeyAscii裏收不到。
利用 KeyAscii =0 的方式在 KeyPress 裏有用,在 KeyDown 裏把 KeyCode=0 可就不管用了,所以 Down,Press,Up 各有各的用處,要分清楚才好。
TextBox 限制输入长度
TextBox 限制输入长度
来源:www.hosp.ncku.edu.tw/~cww/oldguy/oldguy.htm
寄件者: Annie Chiu
在VB中使用text 的maxlength 屬性,我的資料欄位長度為10, 如何控制text 只能輸入10個英文字, 或5個中文字呢?
老怪答:
用 textbox.maxlength 的屬性,它還是會把兩 byte 的中文算一個字,你參考下面的程式碼,或許能達成你的目標。
Private Sub Text1_Change()
Static OldString As String
If LenB(StrConv(Text1.Text, vbFromUnicode)) > 10 Then
Text1.Text = OldString
End If
OldString = Text1.Text
End Sub
ComboBox 的使用技巧
ComboBox 的使用技巧
来源:www.hosp.ncku.edu.tw/~cww/oldguy/oldguy.htm
iroi 撰寫於文章
請問各位,vb的combo box怎用的
老怪答:
在做 Combobox的判斷時,有幾個要注意配合使用的屬性是
.List
text
listindex
newindex
listcount
取出 ComboBox 裏的值
'------ 列出 combobox 所有 list 值
for i=0 to combobox.listcount-1
debug.print combobox.list(i)
next
'------取出以滑鼠點選值
Private Sub Combo1_Click()
debug.print combo1.list(combo1.listindex)
End Sub
'-----取出新加入的值
combo1.addnew "XXXXXX"
debug.print combo1.list(combo1.newindex)
'---- 將組合式文字框加入 Combo1
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
combo1.addnew combo1.text
End If
End Sub
格式刷和粘贴控件
格式刷和粘贴控件
格式刷
单击工具栏上的“格式刷”按钮,鼠标将变成。如果要将相同的格式特性应用到几个控件中,请双击该按钮将其锁定,按鼠标右键取消格式刷。只能从单个的控件中复制特性。
在要要粘贴格式特性的控件上单击,可以单击同类型的控件,也可以选择另一种类型控件。例如,可以从文本框中将格式特性复制到列表框中。
Microsoft Access 将复制下列任一项属性:SpecialEffect(特殊效果)、 BorderStyle(边框样式)、 BorderColor(边框颜色)、 BorderWidth(边框宽度)、 BackColor(背景颜色)、 BackStyle(背景样式)、 FontName(字体)、 FontSize(字号)、FontWeight(字样粗细)、 ForeColor(前景颜色)、 FontItalic(斜体)、 FontUnderline(下划线)、Visible(可见性)、 DisplayWhen(何时显示)、
对于标签控件,还将复制 LabelAlign(标签对齐)属性;
对于文本框控件,还将复制 TextAlign(文本对齐)属性;
对于直线控件,还将复制 LineSlant(斜线)属性。
粘贴控件
你可以确定被粘贴的控件的位置。如果选择某一节,Microsoft Access 将把控件贴在该节的左上角。如在要粘贴的区域附近选定了控件,则 Microsoft Access 将把控件贴在选定控件的下方。但是请注意,如果粘贴标签,而且所选定的控件并没有附属标签,Microsoft Access 将把标签附属到选定的控件。
另外,Microsoft Access 不会复制与控件有关系的事件过程。
如何使非可用的控件不显示成灰色
如何使非可用的控件不显示成灰色
如何使非可用的控件不显示成灰色
作 者:朱亦文
发布日期:2002年10月27日
摘 要:当在窗体放上一个文本框或其它用以输入数据的控件,有的时候我们并不想用它来输入数据,而仅只是为了显示,与其它控件统一风格。意思就是说,不可编辑该控件的值。而控件不可用时是灰色的,哪怎么办呢?本文将为你解决这一问题。
正 文:
当在窗体放上一个文本框或其它用以输入数据的控件,有的时候我们并不想用它来输入数据,而仅只是为了显示,与其它控件统一风格。意思就是说,不可编辑该控件的值。
一般采用的办法是,设置其属性[是否有效](Enabled)为[否](False),这时,该控件就得不到焦点了,当然也就不能编辑它的值。可是,这时控件显示的是灰色的不可用的底色,造成与
时的颜色不一致,破坏了美观,怎么办呢?
解决的办法,就是,将该控件的[是否锁定](Locked)属性设为[是](True),即可。
实现子窗体全选功能
实现子窗体全选功能
Private Sub 复选3_AfterUpdate()
Dim rs As ADODB.Recordset, strSQL As String
Set rs = New ADODB.Recordset
strSQL = "SELECT 是否打印 FROM 表1;"
rs.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
If Not rs.EOF Then rs.MoveFirst
Do While Not rs.EOF
rs(0).value = 复选3.value
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
子对象1.Requery
End Sub
让用户不能随意退出(退出前提示)!
让用户不能随意退出(退出前提示)!
建立一个窗体,名字叫隐藏,并在启动选项内选定这个窗体为启动时自动打开。
然后在窗体的加载事件内加入如下代码:
Private Sub Form_Load()
Me.Visible = False
End Sub
''在窗体的卸载事件中加入如下代码:
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("你真的要退出吗?", vbYesNo + vbQuestion, "请确认…") = vbNo Then Cancel = True
End Sub
在窗体上显示子窗体中的合计数
在窗体上显示子窗体中的合计数
在主窗体显示合计的文本框中直接这样填写就行啦!假设,您要统计的字段名称为:Tcount,该字段所在的表名称为:TableAA,主索引字段名称为Tindex
=Dsum("Tcount","TableAA","Tindex='" & [Tindex] & "'")
图像作窗体背景,让图像大小和窗体的大小保持一致
图像作窗体背景,让图像大小和窗体的大小保持一致。
在FORM_load 和FORM_resize 里加上
图片.width=me.windowwidth
图片.height=me.windowheight
来源:爱赛思应用网。
按特殊名在VBA中设置控件的可见性
按特殊名在VBA中设置控件的可见性
For i = 27 To 47
If Me.Controls.Item(i).Name Like "A*" Then
Me.Controls.Item(i).Visible = False
End If
Next
在多页窗体中用按钮翻页
在多页窗体中用按钮翻页
上一页
Private Sub 上一页_Click()
DoCmd.GoToPage 1
End Sub
下一页
Private Sub 下一页_Click()
DoCmd.GoToPage 2
End Sub
如何使鼠标停留在组合框上时,使组合框自动打开
如何使鼠标停留在组合框上时,使组合框自动打开
Private Sub 文本框_GotFocus()
Me![文本框].Dropdown
End Sub
如何让窗体总在最前面?
如何让窗体总在最前面?
来源不祥.
' API函数声明
Declare Function SetWindowPos Lib "user32" ( ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
' 常量声明
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
' 在某个form里写:
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE ' 或下面
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE