program 2007-07-20 10:28:30 閱讀49 評(píng)論0 字號(hào)：大中小 訂閱
http://www.kaikei.cn/jsj/VBA/JV0000.htm
在VB中對(duì)窗體控件的引用
鍵入包含控件的窗體或報(bào)表的標(biāo)識(shí)符，后面緊接 ! 運(yùn)算符和控件的名稱。例如，下列標(biāo)識(shí)符將引用“訂單”窗體上“訂單ID”控件值：
Forms![訂單]![訂單ID]
引用子窗體或子報(bào)表上的控件，不必使用“窗體”或“報(bào)表”屬性為窗體或報(bào)表指定完整的標(biāo)識(shí)符。例如，可以使用下列標(biāo)識(shí)符來引用“訂單”子窗體上的“數(shù)量”控件：
Forms![訂單]![訂單子窗體]![數(shù)量]
判斷窗體或報(bào)表中控件的數(shù)目，然后將該數(shù)目賦給一個(gè)變量。
Dim intFormControls As Integer
Dim intReportControls As Integer
intFormControls = Forms!Employees.Count
intReportControls = Reports!FreightCharges.Count
設(shè)置控件可見性
Dim i, ii As Integer
For ii = 3 To 10
Me.Controls.Item(ii).Visible = True
Next
For i = 11 To 22
Me.Controls.Item(i).Visible = False
Next
按特殊名在VBA中設(shè)置控件的可見性：
For i = 27 To 47
If Me.Controls.Item(i).Name Like "A*" Then
Me.Controls.Item(i).Visible = False
End If
Next
指定一個(gè)控件能否接受焦點(diǎn)
Enabled屬性：
me.控件.Enabled = true'能
=false'不能
指定一個(gè)控件能否被編輯：
locked
如：
me.控件.Locked = true
me.控件.Locked = false
設(shè)置控件標(biāo)題顯示的文字
Me.控件.Caption = "顯示窗體"
設(shè)置標(biāo)簽顏色：
Me.LabelColor =200
獲得焦點(diǎn)及失去焦點(diǎn)時(shí)字段變更顏色。
如果你的控件是文本框，名稱為“txt字段”，寫如下代碼：
Private Sub txt字段_GotFocus()
Me.txt字段.BackColor = 12632256
End Sub
當(dāng)中“12632256”是灰色，你可以自己選擇希望的顏色，如果想在失去焦點(diǎn)時(shí)改為原來的顏色，寫如下代碼：
Private Sub txt字段_LostFocus()
Me.txt字段.BackColor = 16777215
End Sub
使標(biāo)簽閃爍以引人注意
設(shè)置窗體的TimerInterval 值為1000 (1秒).
forms OnTimer 加入代碼:
Sub Form_Timer()
YourTextLabel.Visible = Not YourTextLabel.Visible
End_Sub
設(shè)置標(biāo)簽字體顏色：
Me.Label1.ForeColor =
設(shè)置文本框顏色：
Me.TextColor = 300
設(shè)置文本框字體顏色：
Me.TextFontColor = 500
標(biāo)簽等左邊距離：
Me.Label2.Left = 2200
定位控件
Me.控件.Top = 8290
Me. 控件.Left = 100
標(biāo)簽等字體粗細(xì)：
Me.Label2.FontWeight = 20000
控件邊框顏色：
Me.Label2.BorderColor = 0
控件邊框線條
BorderStyle 屬性使用以下設(shè)置：
透明 0 （僅對(duì)于標(biāo)簽、圖表和子報(bào)表而言是默認(rèn)值）透明的
實(shí)線 1 （默認(rèn)值）實(shí)線
虛線 2 虛線
短虛線 3 短虛線
點(diǎn)線 4 點(diǎn)線
稀疏點(diǎn)線 5 點(diǎn)距較寬的點(diǎn)線
點(diǎn)劃線 6 虛線與點(diǎn)線組合的點(diǎn)劃線
點(diǎn)點(diǎn)劃線 7 虛線-點(diǎn)線-點(diǎn)線組合的點(diǎn)點(diǎn)劃線
雙實(shí)線 8 雙實(shí)線
指定控件的邊框?qū)挾?/p>
使用 BorderWidth 屬性可以指定控件的邊框?qū)挾?/p>
取值：0或1－6
指定控件是否透明
使BackStyle 屬性可以指定控件是否透明。
True 、False
解除子窗體鎖定
Me.進(jìn)_子窗體.Locked = False '解除子窗體鎖定
將窗體上所有控件的輸入法關(guān)掉!
來源:不祥
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進(jìn)窗體就可以了
列表框的值的引用
如果是單選的列表框，用 me.[列表框名] 來引用；如果要引用不是結(jié)合型列的值，可以用 me.[列表框名].column(n) （第一列n=0，第二列n=1…）
引用多列組合框或列表框中特定的列或列與行的組合
用 0 引用第一列，用 1 引用第二列，依此類推。用 0 引用第一行，用 1 引用第二行，依此類推。例如在含有一列客戶 ID
和一列客戶名稱的列表框中，可以使用如下方式引用第二列、第五行的客戶名稱：
Forms!Contacts!Customers.Column(1, 4)
可以使用 Column 屬性將組合框或列表框的內(nèi)容指定給另一控件，如文本框。例如，若要將文本框的 ControlSource
屬性設(shè)為列表框第二列中的值，可以使用以下表達(dá)式：
=Forms!Customers!CompanyName.Column(1)
如果引用了組合框或列表框中的列，但用戶未做選擇，則 Column 屬性設(shè)置將為 Null?？梢允褂?IsNull 函數(shù)來確定是否進(jìn)行了選擇，示例如下：
If IsNull(Forms!Customers!Country)
Then MsgBox "No selection."
End If
顯示獲得焦點(diǎn)的控件的 Name：
ctl As Control
Set ctl = Screen.ActiveControl
MsgBox ctl.Name
窗體：
指定當(dāng)窗體上的命令按鈕保持按下狀態(tài)時(shí)，是否重復(fù)執(zhí)行事件過程或宏
使用 AutoRepeat 屬性可以指定當(dāng)窗體上的命令按鈕保持按下狀態(tài)時(shí)，是否重復(fù)執(zhí)行事件過程或宏
True 、False
'允許添加
me.AllowAdditions= True
'記錄不鎖定
me.RecordLocks = 1
是否自動(dòng)居中
AutoCenter= True,False
是否自動(dòng)調(diào)整
AutoResize = True,False
窗體邊框樣式
me.BorderStyle=1 中譯:無
其它
1 無
2 細(xì)邊框
3 可調(diào)邊框
4 對(duì)話框邊框
設(shè)置窗體、頁眉、頁腳顏色：
Me.Section(0).BackColor = 200
Me.Section(1).BackColor = 200
Me.Section(2).BackColor = 200
窗體標(biāo)題
me.Caption="中國ACCESS軟件網(wǎng)" 中譯:窗體標(biāo)題為"中國ACCESS軟件網(wǎng)"(不含引號(hào))
關(guān)閉按鈕
me.CloseButton =True 中譯 允許關(guān)閉按鈕
其它:true:允許 False:不允許
控制框
me.ControlBox =True 允許
其它:true:允許 False:不允許
默認(rèn)視圖
me.DefaultView =0 為單一窗口
其它:0:單一窗口1:連續(xù)窗體2:數(shù)據(jù)表
允許分隔線
me.DividingLines =True 中譯 允許分隔線
其它:true:允許 False:不允許
允許打印版式
英文:me.LayoutForPrint =True 中譯 允許打印版式
其它:true:允許 False:不允許
無最大最小化按鈕
英文:me.MinMaxButtons =0 中譯 無最大最小化按鈕
其它:0:無 1:最大化 2:最小化 3:兩者都有
允許瀏覽按鈕
英文:me.NavigationButtons =True 中譯 允許瀏覽按鈕
其它:true:允許 False:不允許
滾動(dòng)條
me.ScrollBars =0二者均無
其它:0:二者均無 1:只垂直 2:只水平3:二者都有
允許/不允許添加
me.AllowAdditions=True/False
允許/不允許刪除
me.AllowDeletions=True/False
允許/不允許編輯
me.AllowEdits=True/False
指定是否允許打開綁定窗體進(jìn)行數(shù)據(jù)輸入
使用 DataEntry 屬性可以指定是否允許打開綁定窗體進(jìn)行數(shù)據(jù)輸入。DataEntry 屬性不決定是否可以添加記錄，只決定是否顯示已有的記錄。Boolean
型，可讀/寫。
True 、False
允許/不允許篩選
me.AllowFilters=True/False
Filter="篩選內(nèi)容"篩選
應(yīng)用與/否篩選
FilterOn=True/False
將 MyForm 窗體的 BackColor 屬性，改成 ColorCode 參數(shù)指定的色彩。
使用 QBColor 函數(shù)將 MyForm 窗體的 BackColor 屬性，改成 ColorCode 參數(shù)指定的色彩。QBColor 可接受 0 到 15
的整型值。
Sub ChangeBackColor (ColorCode As Integer, MyForm As Form) MyForm.BackColor = QBColor(ColorCode)End Sub窗體真正居中顯示
如下代碼可以做到真正居中顯示
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
隱藏窗體[學(xué)生名冊(cè)]數(shù)據(jù)表視圖中的性別字段
Table!學(xué)生名冊(cè)!性別.ColumnHidden = -1
顯示獲得焦點(diǎn)窗體的 Name 屬性設(shè)置：
使用 ActiveForm 屬性（和 Screen 對(duì)象一起）可以標(biāo)識(shí)或引用獲得焦點(diǎn)的窗體。
Dim dqhdct As Form
Set dqhdct = Screen.ActiveForm
MsgBox dqhdct.Name
判斷窗體是否打開的方法
Function IsLoaded(strName As String, Optional intObjectType As Integer =
acForm)
IsLoaded = (SysCmd(acSysCmdGetObjectState, intObjectType, strName) <> 0)
End Function
使用 IsLoaded 屬性可以確定當(dāng)前是否加載了 AccessObject。Boolean 型，只讀。
以下是一個(gè)示例：
If CurrentProject.AllForms("frmMain").IsLoaded = True Then
Forms!frmMain.Form.Visible = False
End If
窗體中組合框不在列表中示例
不在列表中事件代碼：
Private Sub 名稱_NotInList(NewData As String, Response As Integer)
Response = acDataErrContinue
If MsgBox("您輸入的名稱不在列表中，在列表中添加新記錄嗎？", 68, "銀河酒業(yè)") = 6 Then
Me![名稱] = Null
DoCmd.GoToControl "單價(jià)"
DoCmd.OpenForm "酒名列表", , , , acAdd, acNormal
Else
Me![名稱] = Null
Me![名稱].Dropdown
End If
End Sub
獲得焦點(diǎn)事件代碼：
Private Sub 名稱_GotFocus()
Me![名稱].Requery
End Sub
如何讓窗體總在最前面？
*API函數(shù)聲明
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
注釋： 在某個(gè)form里寫：
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOMOVE 注釋：或下面
SetWindowPos me.hWnd,WND_TOPMOST,0,0,0,0, SWP_NOSIZE
Me.graphnow.Object.ChartType = xlBarClustered
移動(dòng)無邊框窗體例子
模塊：
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As
Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
應(yīng)用：
Private Sub Form_Close()
DoCmd.RunCommand acCmdAppMaximize
End Sub
Private Sub Form_Load()
DoCmd.RunCommand acCmdAppMinimize
End Sub
Private Sub XPForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single)
If Button = 1 Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
Private Sub 命令20_Click()
DoCmd.Close
End Sub
日期、時(shí)間函數(shù)
如何將文本型：2003.08.04 轉(zhuǎn)換為日期型：2003-08-04
cdate(replace("2003.08.04",".","-"))
顯示當(dāng)前日期在該年中所處的星期號(hào)
=Format(Now(), "ww")
ww 為 1 到 53。
顯示日期字段值的四位年份值。
=DatePart（"yyyy", [訂購日期]）
顯示日期字段值前 10 天的日期值。
=DateAdd（"y", -10, [應(yīng)付日期]）
顯示日期字段值前一個(gè)月的日期值。
=DateAdd("m",-1,Date())
顯示日期1和日期2之間相差的天數(shù)。
=DateDiff（"d", [訂購日期], [發(fā)貨日期]）
從今天算起到三個(gè)月后的日期之間的記錄。
Betweeb date() and adddate(3,date())
根據(jù)出生日期計(jì)算年齡（周歲）
=IIf(Month(Date())-Month([出生年月日])>-1,Year(Date())-Year([出生年月日]),Year(Date())-Year([出生年月日])-1)
自定義日期/時(shí)間格式 (Format 函數(shù))
(:) 時(shí)間分隔符。在一些區(qū)域，可能用其他符號(hào)來當(dāng)時(shí)間分隔符。格式化時(shí)間值時(shí)，時(shí)間分隔符可以分隔時(shí)、分、秒。時(shí)間分隔符的真正字符在格式輸出時(shí)取決于系統(tǒng)的設(shè)置。
(/) 日期分隔符。在一些區(qū)域，可能用其他符號(hào)來當(dāng)日期分隔符。格式化日期數(shù)值時(shí)，日期分隔符可以分隔年、月、日。日期分隔符的真正字符在格式輸出時(shí)取決于系統(tǒng)設(shè)置。
C 以 ddddd 來顯示日期并且以 ttttt 來顯示時(shí)間。如果想顯示的數(shù)值無小數(shù)部分，則只顯示日期部分，如果想顯示的數(shù)值無整數(shù)部分，則只顯示時(shí)間部分。
D
以沒有前導(dǎo)零的數(shù)字來顯示日 (1 – 31)。
Dd
以有前導(dǎo)零的數(shù)字來顯示日 (01 – 31)。
ddd
以簡寫來表示日 (Sun –Sat)。
dddd
以全稱來表示日 (Sunday –Saturday)。
ddddd
以完整日期表示法顯示（包括年、月、日），日期的顯示要依系統(tǒng)的短日期格式設(shè)置而定。缺省的短日期格式為 m/d/yy。
dddddd
以完整日期表示法顯示日期系列數(shù)（包括年、月、日），日期的顯示要依系統(tǒng)識(shí)別的長日期格式而定。缺省的長日期格式為 mmmm dd, yyyy。
aaaa
與dddd 一樣，它只是該字符串的本地化版本。
W
將一周中的日期以數(shù)值表示（1 表星期日~ 7表星期六）。
ww
將一年中的星期以數(shù)值表示 (1 – 54)。
M
以沒有前導(dǎo)零的數(shù)字來顯示月 (1 – 12)。如果 m 是直接跟在 h 或 hh 之后，那么顯示的將是分而不是月。
mm
以有前導(dǎo)零的數(shù)字來顯示月 (01 – 12)。如果m是直接跟在h或hh之后，那么顯示的將是分而不是月。
mmm
以簡寫來表示月 (Jan –Dec)。
mmmm
以全稱來表示月 (January –December)。
oooo
與mmmm一樣，它只是該字符串的本地化版本。
Q
將一年中的季以數(shù)值表示 (1 – 4)。
Y
將一年中的日以數(shù)值表示 (1 – 366)。
Yy
以兩位數(shù)來表示年 (00 – 99)。
yyyy
以四位數(shù)來表示年 (00 – 99)。
H
以沒有前導(dǎo)零的數(shù)字來顯示小時(shí) (0 – 23)。
Hh
以有前導(dǎo)零的數(shù)字來顯示小時(shí) (00– 23)。
N
以沒有前導(dǎo)零的數(shù)字來顯示分 (0 – 59)。
Nn
以有前導(dǎo)零的數(shù)字來顯示分 (00 – 59)。
S
以沒有前導(dǎo)零的數(shù)字來顯示秒 (0 – 59)。
Ss
以有前導(dǎo)零的數(shù)字來顯示秒 (00 – 59)。
t t t t t
以完整時(shí)間表示法顯示（包括時(shí)、分、秒），用系統(tǒng)識(shí)別的時(shí)間格式定義的時(shí)間分隔符進(jìn)行格式化。如果選擇有前導(dǎo)零并且時(shí)間是在 10:00 A.M. 或
P.M.之前，那么將顯示有前導(dǎo)零的時(shí)間。缺省的時(shí)間格式為 h:mm:ss。
AM/PM
在中午前以 12 小時(shí)配合大寫 AM 符號(hào)來使用；在中午和 11:59 P.M.間以 12 小時(shí)配合大寫 PM 來使用。
Am/pm
在中午前以 12 小時(shí)配合小寫 am 符號(hào)來使用；在中午和 11:59 P.M.間以 12 小時(shí)配合小寫 pm 來使用。
A/P
在中午前以 12 小時(shí)配合大寫A符號(hào)來使用；在中午和 11:59 P.M.間以12 小時(shí)配合大寫P來使用。
a/p
在中午前以 12 小時(shí)配合小寫a符號(hào)來使用；在中午和 11:59 P.M.間以 12 小時(shí)配合小寫p來使用。
AMPM
在中午前以 12 小時(shí)配合系統(tǒng)設(shè)置的 AM字符串文字來使用；在中午和 11:59 P.M. 間以 12 小時(shí)配合系統(tǒng)設(shè)置的 PM 字符串文字來使用。AMPM
可以是大寫或小寫，但必須和您的系統(tǒng)設(shè)置相配。其缺省格式為 AM/PM。
日期函數(shù)示例
當(dāng)天日期：=Date()
當(dāng)日：=Day(date)
當(dāng)月：=Month(date())
當(dāng)年：=Year(date())
當(dāng)季：=DatePart("q",Date())
把日期大寫
Function Date2Chinese(iDate)
Dim num(10)
Dim iYear
Dim iMonth
Dim iDay
num(0) = "〇"
num(1) = "一"
num(2) = "二"
num(3) = "三"
num(4) = "四"
num(5) = "五"
num(6) = "六"
num(7) = "七"
num(8) = "八"
num(9) = "九"
iYear = Year(iDate)
iMonth = Month(iDate)
iDay = Day(iDate)
Date2Chinese = num(iYear \ 1000) + _
num((iYear \ 100) Mod 10) + num((iYear _
\ 10) Mod 10) + num(iYear Mod _
10) + "年"
If iMonth >= 10 Then
If iMonth = 10 Then
Date2Chinese = Date2Chinese + _
"十" + "月"
Else
Date2Chinese = Date2Chinese + _
"十" + num(iMonth Mod 10) + "月"
End If
Else
Date2Chinese = Date2Chinese + _
num(iMonth Mod 10) + "月"
End If
If iDay >= 10 Then
If iDay = 10 Then
Date2Chinese = Date2Chinese + _
"十" + "日"
ElseIf iDay = 20 Or iDay = 30 Then
Date2Chinese = Date2Chinese + _
num(iDay \ 10) + "十" + "日"
ElseIf iDay > 20 Then
Date2Chinese = Date2Chinese + _
num(iDay \ 10) + "十" + _
num(iDay Mod 10) + "日"
Else
Date2Chinese = Date2Chinese + _
"十" + num(iDay Mod 10) + "日"
End If
Else
Date2Chinese = Date2Chinese + _
num(iDay Mod 10) + "日"
End If
End Function
算出每個(gè)月的天數(shù)
一法：
Dim a, b, c
a = Year(Now())
b = Month(Now())
c = Format((a & "/" & b + 1 & "/1"), "######") - Format((a & "/" & b & "/1"),
"######")
二法：
DateDiff("d", Format(Date, "yyyy-mm-01"), Format(DateAdd("m", -1, Date),
"yyyy-mm-01"))
DateDiff可以算出兩個(gè)日期之間相差幾天！
三法：
Day(DateAdd("d", -1, Format(Date, "yyyy-mm-01")))
day函數(shù)可以知道某個(gè)日期是這個(gè)月的第幾天，我們把這個(gè)月的最后一天拿出來DAY一下！
應(yīng)該還有更好的方法！
比如說可以定義一個(gè)數(shù)組，把每個(gè)月的日子放進(jìn)去，或者說寫一個(gè)函數(shù)算每一個(gè)月的天數(shù)
只要考慮一下閨年的問題就可以了！
如何得到某年每個(gè)月的第一天是星期幾
Private Sub Command1_Click()
Dim i As Integer, A As Integer, B As Integer, C As String
A = InputBox("請(qǐng)輸入年份", "某年每個(gè)月的第一天是星期幾")
Form1.Cls
For i = 1 To 12
C = A & "-" & i & "-1"
B = Weekday(C)
Select Case B
Case vbSunday
Print A & "年" & i & "月1日是星期日"
Case vbMonday
Print A & "年" & i & "月1日是星期一"
Case vbTuesday
Print A & "年" & i & "月1日是星期二"
Case vbWednesday
Print A & "年" & i & "月1日是星期三"
Case vbThursday
Print A & "年" & i & "月1日是星期四"
Case vbFriday
Print A & "年" & i & "月1日是星期五"
Case vbSaturday
Print A & "年" & i & "月1日是星期六"
End Select
Next i
End Sub
計(jì)算天數(shù)及月初月末日期
Function 本月天數(shù)(日期 As Date) As Byte
本月天數(shù) = DateSerial(Year(日期), Month(日期) + 1, Day(日期)) - 日期
End Function
Function 月末(日期 As Date) As Date
月末 = DateSerial(Year(日期), Month(日期) + 1, 1) - 1
End Function
Function 月初(日期 As Date) As Date
月初 = 日期 - Day(日期) + 1
End Function
本月最后一日是周幾
SELECT
Weekday(DateAdd("m",1,DateSerial(Year(Date()),Month(Date()),1)-1)) AS
本月最后一日是周幾,
下月最后一日是周幾
SELECT
Weekday(DateAdd("m",2,DateSerial(Year(Date()),Month(Date()),1)-1)) AS 下月最后一日是周幾,
本月最后一個(gè)周5到月底的天數(shù)
SELECT
(Weekday(DateAdd("m",1,DateSerial(Year(Date()),Month(Date()),1)-1))+1) Mod 7 AS
本月最后一個(gè)周5到月底的天數(shù);
下月最后一個(gè)周5到月底的天數(shù)
SELECT
(Weekday(DateAdd("m",2,DateSerial(Year(Date()),Month(Date()),1)-1))+1) Mod 7 AS
下月最后一個(gè)周5到月底的天數(shù);
本月最后一個(gè)周5的日期
SELECT
DateAdd("m",1,DateSerial(Year(Date()),Month(Date()),1))-1-(Weekday(DateAdd("m",1,DateSerial(Year(Date()),Month(Date()),1)-1))+1)
Mod 7 AS 本月最后一個(gè)周5的日期;
下月最后一個(gè)周5的日期
SELECT
DateAdd("m",2,DateSerial(Year(Date()),Month(Date()),1))-1-(Weekday(DateAdd("m",2,DateSerial(Year(Date()),Month(Date()),1)-1))+1)
Mod 7 AS 下月最后一個(gè)周5的日期;
數(shù)據(jù)輸入、查詢、計(jì)算、連接：
通過英特網(wǎng)的ACCESS聯(lián)接
在ACCESS中使用ADO：
Private Sub ABC_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cn.OPEN "DSN=alwin;UID=;PWD=;"
rs.OPEN "Select * from tbTABLE", cn, adOpenDynamic, adLockReadOnly’
rs.ABC App.Path & "\testdata.dat", adPersistADTG
rs.Close
cn.Close
MsgBox ("OPERATION OK")
End Sub
Private Sub OPEN_Click()
Dim strConnect As String
strConnect = "Provider=MSPersist"
Dim rs As New ADODB.Recordset
rs.OPEN "http://遠(yuǎn)程服務(wù)器的IP/test/testdata.dat", strConnect
Do While Not rs.EOF
Debug.Print rs("USERID").value
rs.MoveNext
Loop
End Sub
將用戶輸入的身份證號(hào)15位數(shù)據(jù)轉(zhuǎn)化為18位。
Function IDCode15to18(sCode15 As String) As String
'* 功能:將15的身份證號(hào)升為18位(根據(jù)GB 11643-1999)
'* 參數(shù):原來的號(hào)碼
'* 返回:升位后的18位號(hào)碼
Dim i As Integer
Dim num As Integer
Dim code As String
num = 0
IDCode15to18 = Left(sCode15, 6) + "19" + Right(sCode15, 9)
' 計(jì)算校驗(yàn)位
For i = 18 To 2 Step -1
num = num + (2 ^ (i - 1) Mod 11) * (Mid(IDCode15to18, 19 - i, 1))
Next i
num = num Mod 11
Select Case num
Case 0
code = "1"
Case 1
code = "0"
Case 2
code = "X"
Case Else
code = Trim(Str(12 - num))
End Select
IDCode15to18 = IDCode15to18 + code
End Function
據(jù)身份證號(hào)自動(dòng)輸入出生日期
Dim Length As Integer
Length = Len(Me.[身份證號(hào)])
If Not IsNull(Length) Then
If Length = 15 Then
Me.[性別] = IIf(Val(Mid(Me.身份證號(hào), 15, 1)) / 2 = Int(Val(Mid(Me.身份證號(hào), 15, 1)) /
2), "女", "男")
Me.[出生日期] = "19" & Mid([身份證號(hào)], 7, 2) & "-" & Mid([身份證號(hào)], 9, 2) & "-" &
Mid([身份證號(hào)], 11, 2)
ElseIf Length = 18 Then
Me.[性別] = IIf(Val(Mid(Me.身份證號(hào), 17, 1)) / 2 = Int(Val(Mid(Me.身份證號(hào), 17, 1))
/ 2), "女", "男")
Me.[出生日期] = Mid([身份證號(hào)], 7, 4) & "-" & Mid([身份證號(hào)], 11, 2) & "-" &
Mid([身份證號(hào)], 13, 2)
Else
MsgBox "身份證號(hào)錯(cuò)誤！"
End If
End If
兩行代碼打開另一數(shù)據(jù)庫
Private Sub 命令4_Click()
On Error GoTo Err_命令4_Click
Dim strDb As String
strDb = "C:\db1.mdb"
SendKeys "{F11}%FO" & strDb & "{enter}"
Exit_命令4_Click:
Exit Sub
Err_命令4_Click:
MsgBox Err.Description
Resume Exit_命令4_Click
End Sub
實(shí)現(xiàn)打開外部數(shù)據(jù)庫中的報(bào)表。
Private Declare Function apiSetForegroundWindow Lib "user32" _
Alias "SetForegroundWindow" _
(ByVal hwnd As Long) _
As Long
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long
Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1
Function fOpenRemoteReport(strMDB As String, strReport As String, _
Optional intView As Variant) _
As Boolean
' strMDB: 外部數(shù)據(jù)庫名稱(含路徑)
' strReport: 報(bào)表名稱
' intView: 報(bào)表的打開方式
Dim objAccess As Access.Application
Dim lngRet As Long
On Error GoTo fOpenRemoteReport_Err
If IsMissing(intView) Then intView = acViewPreview
If Len(Dir(strMDB)) > 0 Then
Set objAccess = New Access.Application
With objAccess
lngRet = apiSetForegroundWindow(.hWndAccessApp)
lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
' 第一次調(diào)用ShowWindow似乎不做任何事情
lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
.OpenCurrentDatabase strMDB
.DoCmd.OpenReport strReport, intView
Do While Len(.CurrentDb.Name) > 0
DoEvents
Loop
End With
End If
fOpenRemoteReport_Exit:
On Error Resume Next
objAccess.Quit
Set objAccess = Nothing
Exit Function
fOpenRemoteReport_Err:
fOpenRemoteReport = False
Select Case Err.Number
Case 7866:
' mdb 已經(jīng)被用獨(dú)占方式打開
MsgBox "該數(shù)據(jù)庫：" & strMDB & _
vbCrLf & "已經(jīng)被用獨(dú)占方式打開！" & vbCrLf _
& vbCrLf & "請(qǐng)重新用共享方式打開，再試一次！", _
vbExclamation + vbOKOnly, "不能打開數(shù)據(jù)庫"
Case 2103:
' 報(bào)表不存在
MsgBox "在這個(gè)" & strMDB & "數(shù)據(jù)庫中不存在該報(bào)表：" & strReport & _
vbCrLf & vbCrLf , _
vbExclamation + vbOKOnly, "報(bào)表不存在"
Case 7952:
' 用戶關(guān)閉了這個(gè) mdb
fOpenRemoteReport = True
Case Else:
MsgBox "錯(cuò)誤#: " & Err.Number & vbCrLf & Err.Description, _
vbCritical + vbOKOnly, "運(yùn)行時(shí)錯(cuò)誤"
End Select
Resume fOpenRemoteReport_Exit
End Function
為列表框定數(shù)據(jù)源
Dim str3 As String
str3 = "SELECT jhd_mx_jiage.wp_leibie AS 類別, jhd_mx_jiage.wp_migceg AS 名稱,
jhd_mx_jiage.wp_xighao AS 型號(hào), jhd_mx_jiage.jhmx_danwei AS 單位,
jhd_mx_jiage.jhmx_danjia AS 單價(jià) FROM jhd_mx_jiage " & " where
jhd_mx_jiage.wp_leibie='" & Listjhlb & "'"
Me.Listjhwp.RowSource = str3
Me.Listjhwp.Requery
為組合框、子窗體設(shè)置數(shù)據(jù)源
下面的示例將組合框的 RowSourceType 屬性設(shè)為“Table/Query”，然后將 RowSource 屬性設(shè)為“雇員列表”查詢。
Forms!Employees!cmboNames.RowSourceType = "Table/Query"
Forms!Employees!cmboNames.RowSource = "EmployeeList"
一：
Dim str1 As String
str1 = "SELECT ziyuag.zy_daihao,
ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag " & " where
zy_daihao='" & Text8dldh & "'and zy_mima='" & Text10dlmm & "'"
Me.Child6zy.Form.RecordSource = str1
Me.Child6zy.Requery
二：
子窗體.FORM.recordsourse="SELECT ziyuag.zy_daihao,
ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag " & " where
zy_daihao='" & Text8dldh & "'and zy_mima='" & Text10dlmm & "'"
三：
Private Sub Command38_Click()
Dim sjy As String
Dim pd As Integer
pd = True
sjy = "SELECT 病歷明細(xì)表.* FROM 病歷明細(xì)表"
If Not IsNull(Text0) Then
If pd Then
sjy = sjy & " where 姓名 like '" & Text0 & "'"
pd = False
Else
sjy = sjy & " and 姓名 like '" & Text0 & "'"
End If
End If
If Not IsNull(Text1) And Not IsNull(Text2) Then
sjy = sjy & " where 時(shí)間 between #" & Text1 & "# and #" & Text2 & "#"
pd = False
Else
str2 = str2 & " and 時(shí)間 between #" & Text1 & "# and #" & Text2 & "#"
End If
If Not IsNull(Text3) Then
If pd Then
sjy = sjy & " where 姓名 like '" & Text3 & "'"
pd = False
Else
sjy = sjy & " and 姓名 like '" & Text3 & "'"
End If
End If
Me.子窗體.RowSource = sjy
Me.Requery
End Sub
為主窗體、報(bào)表設(shè)數(shù)據(jù)源
使用 RecordSource 屬性可以指定窗體或報(bào)表的數(shù)據(jù)源。String 型，可讀寫。
一：
Dim sjy As String
sjy = "SELECT 名單.* FROM 名單" & " where 姓名 like '*" & List101 & "*'"
Me.RecordSource = sjy
Requery
二：
me.RecordSource = "名單"
用其他ACCESS的表作為本ACCESS 窗體的數(shù)據(jù)源
來源：ACCESS中國 Trynew
在Sql語句中的表名前加上數(shù)據(jù)庫名就行了，下面語句動(dòng)態(tài)引用當(dāng)前目錄的另一MDB文件的表做數(shù)據(jù)源：
Private Sub Form_Load()
Me.RecordSource = "SELECT 表1.* FROM [" & CurrentProject.Path & "\db1.mdb" &
"].表1;"
End Sub
用VBA編程把Excel表中數(shù)據(jù)追加到Access表中
Private Sub Command0_Click()
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "temp",
"c:\temp.xls", yes
End Sub
VB語句刪除記錄：
For I = 1 To 20
SQL = "DELETE 訂單明細(xì)ID FROM 訂單明細(xì) WHERE 訂單明細(xì)ID=" & I
DoCmd.RunSQL SQL
Next
或：
CurrentProject.Connection.Execute "DELETE * FROM要?jiǎng)h除記錄的表"
插入／刪除一條記錄
新建：DoCmd.RunCommand acCmdRecordsGoToNew
刪除：DoCmd.RunCommand acCmdDeleteRecord
清空表記錄的方法
1、CurrentDb().Execute "delete * from 表名"
2、docmd.runsql "SQL語句"
3，RunSQL "Delete * From 表名"
用代碼實(shí)現(xiàn)對(duì)數(shù)據(jù)修改或增加的取消
在窗體中修改數(shù)據(jù)時(shí)，關(guān)閉窗體，數(shù)據(jù)已經(jīng)修改，這樣很容易產(chǎn)生錯(cuò)誤數(shù)據(jù).
可采用如下方法解決:
在窗體更新前判斷:
Private Sub FORM_BeforeUpdate(Cancel As Integer)
If MsgBox("保存嗎?", vbYesNo, Me.Caption) <> vbYes Then
Cancel = True
End If
End Sub
' 去除系統(tǒng)的報(bào)錯(cuò)信息:
Private Sub FORM_Error(DataErr As Integer, Response As Integer)
Response = acDataErrContinue
End Sub
檢查數(shù)據(jù)是否被修改，無則退出，有則詢問是否保存
'在窗體的字段的“屬性”“事件”“更新后”的右邊輸入“=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("當(dāng)前數(shù)據(jù)已經(jīng)被修改，是否保存？", vbYesNo + vbQuestion, "請(qǐng)選擇...") = vbYes Then
Else
Me.Undo
End If
End If
DoCmd.Close
定義記錄集
Dim rst As New ADODB.Recordset
打開記錄集
rst.Open "SELECT 語句, 關(guān)鍵字 FROM 結(jié)果語句表", CurrentProject.Connection, adOpenKeyset,
adLockOptimistic
兩子窗體之間字段賦值：
Forms!aaa!bbb.Form!bb = Forms!aaa!ccc.Form!cc
確定所顯示的當(dāng)前記錄的記錄編號(hào)。
下面的示例顯示如何使用 Currentrecord 屬性來確定所顯示的當(dāng)前記錄的記錄編號(hào)。在通用過程 Currentformrecord
中將當(dāng)前記錄的編號(hào)值賦給變量 Lngrecordnum。
Sub CurrentFormRecord(frm As Form)
Dim lngrecordnum As Long
lngrecordnum = frm.CurrentRecord 'CurrentRecord是當(dāng)前記錄號(hào)
End Sub
讀取最后一條記錄
dlast("字段名","表名")
在字段默認(rèn)值中用此函數(shù)能使該字段的新紀(jì)錄顯示上一條記錄該字段的值
怎樣使窗體一打開就定位到指定記錄上
定義了一個(gè)變量lngbh，要窗體打開時(shí)顯示ID=Lngbh的這條記錄。
DoCmd.OpenForm "formname", acNormal, , "ID =" & LNGBH, acFormEdit,
acWindowNormal
使用API函數(shù)sendmessage，獲得光標(biāo)所在行和列。
Sub getcaretpos(byval TextHwnd&,LineNo&,ColNo&)
注釋：TextHwnd為TextBox的hWnd屬性值， LineNo為所在行數(shù)，ColNo為列數(shù)
dim I&,j&,k& 注釋：獲取起始位置到光標(biāo)所在位置字節(jié)數(shù) I=SendMessage(TextHwnd,&HB0&,0,0)
j=I/2^16 注釋：確定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1
注釋：確定所在列
k=SendMessage(TextHwnd,&HBB&,-1,0)
ColNo=j-k+1
End sub
如何在打開窗體時(shí)自動(dòng)到相應(yīng)記錄
用法:DoCmd.RunCommand acCmdRecordsGoToNew
acCmdRecordsGoToFirst 移到第一條記錄
acCmdRecordsGoToLast 移到最后一條記錄
acCmdRecordsGoToNew 新增一條記錄
acCmdRecordsGoToNext 移到下一條記錄
acCmdRecordsGoToPrevious 移到上一條記錄
判斷記錄的位置
來自：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條記錄
判斷為是否新增記錄
me.newrecord=true
me.newrecord=false
自動(dòng)編號(hào)
一：
=IIf(Left(Nz(DMax("[jhd_id]","jinhuodan",""),0),6)<>Format(Date(),"yyyymm"),Format(Date(),"yyyymm")
& "001",Format(Date(),"yyyymm") &
Format(Val(Right(Nz(DMax("[jhd_id]","jinhuodan",""),0),3))+1,"000"))
二：
=nz(DLookUp("編號(hào)","登記表","[id]=DMax('id','登記表')"))+1
自動(dòng)編號(hào)
方法一按時(shí)間自動(dòng)編號(hào)：
dim a,b
a=dmax("[自動(dòng)編號(hào)]","編號(hào)表")+1
b=format(date(),"yyyymm") & 00
if a>b then
me.自動(dòng)編號(hào)=a
else:
me.自動(dòng)編號(hào)=b+1
end if
方法二，按時(shí)間自動(dòng)編號(hào)：
Dim a As String
a = Nz(DMax("銷售單號(hào)", "銷售帳單", ""), 0)
If Left(a, 6) <> Format(Date, "yyyymm") Then
銷售單號(hào) = Format(Date, "yyyymm") & "01"
Else
銷售單號(hào) = Format(Date, "yyyymm") & Format(Val(Right(a, 2)) + 1, "00")
End If
方法三，按月分類自動(dòng)編號(hào)：
Dim id, date2 As String
date2 = "GF" & [部門代碼] & Format([入庫日期], "YYYYMM")
id = DMax("[rk編號(hào)]", "[入庫單]", "[rk編號(hào)] Like '" & date2 & "???'")
If IsNull(id) Then
Me.RK編號(hào) = date2 & "001"
Else
Me.RK編號(hào) = date2 & Format(CStr(CInt(Right(id, 3)) + 1), "000")
End If
按任意輸入的日期值的年月自動(dòng)編號(hào)
Dim a, b, c
c = Format(Me.憑證日期, "yyyymm")
b = Nz(c, 0) * 1000
a = Nz(DMax("[憑證號(hào)碼]", "憑證",
"format(憑證.憑證日期,'yyyymm')=format([forms]![憑證錄入].[憑證日期],'yyyymm')"), 0) + 1
If a > b Then
Me.憑證號(hào)碼 = a
Else:
Me.憑證號(hào)碼 = b + 1
End If
新增一條記錄時(shí)使用Right及DMax函數(shù)讓字段的數(shù)字部分自動(dòng)加1
答：使用Right及DMax函數(shù)返回字段“FOO”的數(shù)字部分的最大值，然后加1
表達(dá)式為：
="REC-" & right(DMax("FOO", "FOOTable"), _
Len(DMax("FOO", "FOOTable")) - _
InStr(1, DMax("FOO", "FOOTable"), "-")) + 1
注意：但如果很多用戶或多個(gè)程序都使用DMax去實(shí)現(xiàn)這個(gè)結(jié)果的話，特別在一個(gè)很大的表中這個(gè)過程會(huì)很慢，所以建議使用DefaultValue，它僅僅使用DMax一次
程序如下，寫在更新事件中
Private Sub SomeField_AfterUpdate()
Dim strMax as string
strMax =DMax("FOO", "FOOTable")
me!HiddenFooCtl = "REC-" & right(strMax, len(strMax) - Instr(1,strMax, "-")) +1
End Sub
用按鈕在窗體中添加新記錄
Private Sub 添加新記錄_Click()
DoCmd.GoToRecord , , acNewRec
End Sub
從文本框里輸入新的數(shù)據(jù)庫路徑，然后更新鏈接。
Private Sub Command0_Click()
Dim cat As ADOX.Catalog
Dim tdf As ADOX.Table
Me.txtDBnewNAME.SetFocus
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection
Set tdf = cat.Tables("mytable")
tdf.Properties("jet oledb:link datasource")=Me.txtDBnewNAME.Text
End Sub
查看當(dāng)前庫的路徑
方法1.
= CurrentProject.Path
方法2.
Dim DBLongname, DBName, DBDir As String
DBLongname = CodeDb.Name
DBName = Dir(DBLongname)
DBDir = Left(DBLongname, Len(DBLongname) - Len(DBName))
MsgBox "數(shù)據(jù)庫所在目錄：" & DBDir
用ADO打開鏈接表
這是我以前十分頭痛的問題，不知道那一堆一串的是什么意思現(xiàn)在知道了，這個(gè)是打開ACCESS的，打開別的表不在此討論之內(nèi)。
Dim appAccess As ADODB.Connection
Dim strCn, temp As String
Dim cat As ADOX.Catalog
Dim rstEmployees As ADODB.Recordset
Dim intloop As Integer
Dim tbl1, tblEmp As ADOX.Table
Dim idx As ADOX.Index
strCn = "provider=microsoft.jet.oledb.4.0;password=;user id=admin; data
source=" _
& "C:\Program Files\zhanyexing\123.mdb;Jet OLEDB:Database Password=；"
Set appAccess = New ADODB.Connection
appAccess.Open strCn
Set cat = New ADOX.Catalog
cat.ActiveConnection = appAccess
路徑改成自己的，如果有密碼則在紅色的Password=后面寫上正確的密碼，別的照抄就行了
如何更該鏈接表的設(shè)置
來源：ALEX
例如，數(shù)據(jù)庫當(dāng)前的路徑可以用application.CurrentProject.Path得到，然后用
application.CurrentProject.Path + "\link\abc.mdb"就可以指向數(shù)據(jù)庫安裝目錄下面
link子目錄下的ABC.MDB。
如何在ADP啟動(dòng)時(shí),判斷數(shù)據(jù)庫連接是否有效并重新連接
這是微軟MSDN中，在ADP項(xiàng)目中創(chuàng)建ADP的數(shù)據(jù)庫的默認(rèn)連接的代碼
Public Function sCreateConnection(sSvrName As String, sUID As String, sPWD As
String, sDatabase As String) As String
'********************************************************************
'該函數(shù)在ADP中檢查連接，如果沒有，它將通過輸入?yún)?shù)創(chuàng)建一個(gè)連接
聯(lián)系客服
