★VB打開EXCEL的方法 一樓的沒有指明 Dim xlBook As Excel.WorkBook Set xlBook = App.Workbooks.Open("文件名") 這種語法同樣要求excel已經(jīng)存在才能操作。
Public xlApp As Excel.Application Public xlBook As Excel.Workbook Public xlChar As New Excel.Chart Public xlSheet As New Excel.Worksheet
Set xlApp = New Excel.Application Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets.Add xlSheet.Cells(1, 1) = "測(cè)試" '寫入內(nèi)容 xlBook.SaveAs ("FILENAME") '保存文件 xlApp.Quit Set xlApp = Nothing
本方法采用add添加excel文件和datasheet,然后用save保存。如果用xlApp.Visible=False,則自動(dòng)生成文件。但是如果文件已經(jīng)存在,則會(huì)彈出是否覆蓋的提示。因此,最好先在程序中檢查文件是否已經(jīng)存在,如果存在,則用普通方法打開。如果不存在,則用add添加,并保存。
★打開相對(duì)路徑下的文件 Private Sub Command1_Click() Shell App.Path & "\aaa.bat" End Sub
還有更簡(jiǎn)單的: Private Sub Command1_Click() Shell "aaa.bat" End Sub
aaa.bat就是那個(gè)BAT的名字.
那就不一定...... 因?yàn)镾HELL只對(duì)可執(zhí)行文件有效.你可用WINDOWS外殼程序explorer.exe打開任何文件(包括文件夾)
代碼: Private Sub Command1_Click() Shell "explore.exe aaa.jpg" End Sub
★VB調(diào)用EXCEL自帶的查詢功能在表格中查找內(nèi)容 Private Sub ComCx_Click()
On Error GoTo 50
i = xlBook.Worksheets("代碼").Range("A:A").Find(Trim(TexDm.Text)).Row
★將程序中所有這一類的對(duì)象的某一屬性全部更改為需要的屬性 Dim Item As Object '定義對(duì)象 For Each Item In Me If TypeOf Item Is TextBox Then Item.Text = "" '將所有TextBox的Text屬性值變?yōu)榭?BR>If TypeOf Item Is ComboBox Then Item.ListIndex = -1 '將所有的ComboBox的ListIndex屬性值變?yōu)椤?1” Next
If Not i = 0 Then Dm = Trim(TexDm.Text) Sm = Trim(xlBook.Worksheets("代碼").Cells(i, "B").Value) Dw = Trim(xlBook.Worksheets("代碼").Cells(i, "D").Value) TexSm.Text = Sm & " " & "(" & Dw & ")" ComQd.Visible = True GoTo 100 End If
50 TexSm.Text = "沒有找到相匹配的信息!" 100 End Sub
★如何使編的程序可以調(diào)用excel 首先要引用
再定義對(duì)象及其類型 Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") '創(chuàng)建EXCEL對(duì)象 Set xlBook = xlApp.Workbooks.Open("D:\檢包組\合金廠代碼查詢\xls\合金JDE代碼.xls") xlApp.Visible = False Set xlSheet = xlBook.Worksheets("確認(rèn)信息")
★另存為 ChDir "D:\" ActiveWorkbook.SaveAs Filename:="D:\合金廠產(chǎn)品質(zhì)檢明細(xì)表.xls", FileFormat:=xlExcel8, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False
VB是常用的應(yīng)用軟件開發(fā)工具之一,由于VB的報(bào)表功能有限,而且一但報(bào)表格式發(fā)生變化,就得相應(yīng)修改程序,給應(yīng)用軟件的維護(hù)工作 帶來極大的不便。因此有很多程序員現(xiàn)在已經(jīng)充分利用EXECL的強(qiáng)大報(bào)表功來實(shí)現(xiàn)報(bào)表功能。但由于VB與EXCEL由于分別屬于不同的應(yīng)用系統(tǒng), 如何把它們有機(jī)地結(jié)合在一起,是一個(gè)值得我們研究的課題。
一、 VB讀寫EXCEL表:
VB本身提自動(dòng)化功能可以讀寫EXCEL表,其方法如下:
1、在工程中引用Microsoft Excel類型庫(kù):
從"工程"菜單中選擇"引用"欄;選擇Microsoft Excel 9.0 Object Library(EXCEL2000),然后選擇"確定"。表示在工程中要引用 EXCEL類型庫(kù)。
2、在通用對(duì)象的聲明過程中定義EXCEL對(duì)象:
Dim xlApp As Excel.Application Dim xlBook As Excel.WorkBook Dim xlSheet As Excel.Worksheet
3、在程序中操作EXCEL表常用命令:
Set xlApp = CreateObject("Excel.Application") '創(chuàng)建EXCEL對(duì)象 Set xlBook = xlApp.Workbooks.Open("文件名") '打開已經(jīng)存在的EXCEL工件簿文件 xlApp.Visible = True '設(shè)置EXCEL對(duì)象可見(或不可見) Set xlSheet = xlBook.Worksheets("表名") '設(shè)置活動(dòng)工作表 xlSheet.Cells(row, col) =值 '給單元格(row,col)賦值 xlSheet.PrintOut '打印工作表 xlBook.Close (True) '關(guān)閉工作簿 xlApp.Quit '結(jié)束EXCEL對(duì)象 Set xlApp = Nothing '釋放xlApp對(duì)象 xlBook.RunAutoMacros (xlAutoOpen) '運(yùn)行EXCEL啟動(dòng)宏 xlBook.RunAutoMacros (xlAutoClose) '運(yùn)行EXCEL關(guān)閉宏
4、在運(yùn)用以上VB命令操作EXCEL表時(shí),除非設(shè)置EXCEL對(duì)象不可見,否則VB程序可繼續(xù)執(zhí)行其它操作,也能夠關(guān)閉EXCEL,同時(shí)也可對(duì) EXCEL進(jìn)行操作。但在EXCEL操作過程中關(guān)閉EXCEL對(duì)象時(shí),VB程序無法知道,如果此時(shí)使用EXCEL對(duì)象,則VB程序會(huì)產(chǎn)生自動(dòng)化錯(cuò)誤。形成 VB程序無法完全控制EXCEL的狀況,使得VB與EXCEL脫節(jié)。
二、 EXCEL的宏功能:
EXCEL提供一個(gè)Visual Basic編輯器,打開Visual Basic編輯器,其中有一工程屬性窗口,點(diǎn)擊右鍵菜單的"插入模塊",則增加一個(gè) "模塊1",在此模塊中可以運(yùn)用Visual Basic語言編寫函數(shù)和過程并稱之為宏。其中,EXCEL有兩個(gè)自動(dòng)宏:一個(gè)是啟動(dòng)宏(Sub Auto_Open()) ,另一個(gè)是關(guān)閉宏(Sub Auto_Close())。它們的特性是:當(dāng)用EXCEL打含有啟動(dòng)宏的工簿時(shí),就會(huì)自動(dòng)運(yùn)行啟動(dòng)宏,同理,當(dāng)關(guān)閉含有關(guān)閉 宏的工作簿時(shí)就會(huì)自動(dòng)運(yùn)行關(guān)閉宏。但是通過VB的自動(dòng)化功能來調(diào)用EXCEL工作表時(shí),啟動(dòng)宏和關(guān)閉宏不會(huì)自動(dòng)運(yùn)行,而需要在VB中通過命令 xlBook.RunAutoMacros (xlAutoOpen)和xlBook.RunAutoMacros (xlAutoClose) 來運(yùn)行啟動(dòng)宏和關(guān)閉宏。
三、 VB與EXCEL的相互勾通:
充分利用EXCEL的啟動(dòng)宏和關(guān)閉宏,可以實(shí)現(xiàn)VB與EXCEL的相互勾通,其方法如下:
在EXCEL的啟動(dòng)宏中加入一段程序,其功能是在磁盤中寫入一個(gè)標(biāo)志文件,同時(shí)在關(guān)閉宏中加入一段刪除此標(biāo)志文件的程序。VB程序在 執(zhí)行時(shí)通過判斷此標(biāo)志文件存在與否來判斷EXCEL是否打開,如果此標(biāo)志文件存在,表明EXCEL對(duì)象正在運(yùn)行,應(yīng)該禁止其它程序的運(yùn)行。 如果此標(biāo)志文件不存在,表明EXCEL對(duì)象已被用戶關(guān)閉,此時(shí)如果要使用EXCEL對(duì)象運(yùn)行,必須重新創(chuàng)建EXCEL對(duì)象。
四、舉例:
1、在VB中,建立一個(gè)FORM,在其上放置兩個(gè)命令按鈕,將Command1的Caption屬性改為EXCEL,Command2的Caption屬性改為End。然后 在其中輸入如下程序:
Dim xlApp As Excel.Application '定義EXCEL類 Dim xlBook As Excel.Workbook '定義工件簿類 Dim xlsheet As Excel.Worksheet '定義工作表類 Private Sub Command1_Click() '打開EXCEL過程 If Dir("D:\temp\excel.bz") = "" Then '判斷EXCEL是否打開 Set xlApp = CreateObject("Excel.Application") '創(chuàng)建EXCEL應(yīng)用類 xlApp.Visible = True '設(shè)置EXCEL可見 Set xlBook = xlApp.Workbooks.Open("D:\temp\bb.xls") '打開EXCEL工作簿 Set xlsheet = xlBook.Worksheets(1) '打開EXCEL工作表 xlsheet.Activate '激活工作表 xlsheet.Cells(1, 1) = "abc" '給單元格1行駛列賦值 xlBook.RunAutoMacros (xlAutoOpen) '運(yùn)行EXCEL中的啟動(dòng)宏 Else MsgBox ("EXCEL已打開") End If End Sub
Private Sub Command2_Click() If Dir("D:\temp\excel.bz") <> "" Then '由VB關(guān)閉EXCEL xlBook.RunAutoMacros (xlAutoClose) '執(zhí)行EXCEL關(guān)閉宏 xlBook.Close (True) '關(guān)閉EXCEL工作簿 xlApp.Quit '關(guān)閉EXCEL End If Set xlApp = Nothing '釋放EXCEL對(duì)象 End End Sub
2、在D盤根目錄上建立一個(gè)名為Temp的子目錄,在Temp目錄下建立一個(gè)名為"bb.xls"的EXCEL文件。
3、在"bb.xls"中打開Visual Basic編輯器,在工程窗口中點(diǎn)鼠標(biāo)鍵選擇插入模塊,在模塊中輸入入下程序存盤:
Sub auto_open() Open "d:\temp\excel.bz" For Output As #1 '寫標(biāo)志文件 Close #1 End Sub Sub auto_close() Kill "d:\temp\excel.bz" '刪除標(biāo)志文件 End Sub
4、運(yùn)行VB程序,點(diǎn)擊EXCEL按鈕可以打開EXCEL系統(tǒng),打開EXCEL系統(tǒng)后,VB程序和EXCEL分別屬兩個(gè)不同的應(yīng)用系統(tǒng),均可同時(shí)進(jìn)行操作, 由于系統(tǒng)加了判斷,因此在VB程序中重復(fù)點(diǎn)擊EXCEL按鈕時(shí)會(huì)提示EXCEL已打開。如果在EXCEL中關(guān)閉EXCEL后再點(diǎn)EXCEL按鈕,則會(huì)重新打開 EXCEL。而無論EXCEL打開與否,通過VB程序均可關(guān)閉EXCEL。這樣就實(shí)現(xiàn)了VB與EXCEL的無縫連接。
★JDE代碼查詢程序源代碼
Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim Dm As String Dim Sm As String Dim Dw As String Dim i As Integer Dim SouS As Object
Private Sub ComCx_Click() 'i = 2 'Do While i <= 10000 'Dm = Trim(xlBook.Worksheets("代碼").Cells(i, "A").Value) 'If Dm = Trim(TexDm.Text) Then 'Sm = Trim(xlBook.Worksheets("代碼").Cells(i, "B").Value) 'Dw = Trim(xlBook.Worksheets("代碼").Cells(i, "D").Value) 'TexSm.Text = Sm & " " & "(" & Dw & ")" 'GoTo 100 ' End If
'i = i + 1 'Loop 'TexSm.Text = "沒有找到相匹配的信息!"
On Error GoTo 50
i = xlBook.Worksheets("代碼").Range("A:A").Find(Trim(TexDm.Text)).Row
If Not i = 0 Then Dm = Trim(TexDm.Text) Sm = Trim(xlBook.Worksheets("代碼").Cells(i, "B").Value) Dw = Trim(xlBook.Worksheets("代碼").Cells(i, "D").Value) TexSm.Text = Sm & " " & "(" & Dw & ")" ComQd.Visible = True GoTo 100 End If
50 TexSm.Text = "沒有找到相匹配的信息!"
100 End Sub
Private Sub ComQc_Click() TexDm.Text = "請(qǐng)?jiān)诖溯斎?0位數(shù)的代碼" TexSm.Text = "" Dm = "" Sm = "" Dw = "" ComQd.Visible = False
End Sub
Private Sub ComQd_Click() xlSheet.Cells(2, "A").Value = Dm xlSheet.Cells(2, "B").Value = Sm xlSheet.Cells(2, "C").Value = Dw xlBook.Save End Sub
Private Sub ComTc_Click() xlBook.Close (False) xlApp.Quit Set xlApp = Nothing Set xlBook = Nothing Set xlSheet = Nothing End End Sub
Private Sub Form_Load() Set xlApp = CreateObject("Excel.Application") '創(chuàng)建EXCEL對(duì)象 Set xlBook = xlApp.Workbooks.Open(App.Path & "\xls\合金JDE代碼.xls") xlApp.Visible = False Set xlSheet = xlBook.Worksheets("確認(rèn)信息")
End Sub
Private Sub TexDm_DblClick() TexDm.Text = "" End Sub
★ select case.... case ... end select 用法:
Select Case ComFgYy1.Text Case "缺邊掉角" xlsheet.Cells(i, "P").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "Q").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "R").Value = Trim(TexFgQk1.Text) Case "變形" xlsheet.Cells(i, "S").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "T").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "U").Value = Trim(TexFgQk1.Text) Case "表面鼓泡" xlsheet.Cells(i, "V").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "W").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "X").Value = Trim(TexFgQk1.Text) Case "尺寸超差" xlsheet.Cells(i, "Y").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "Z").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "AA").Value = Trim(TexFgQk1.Text) end select
★ 添加子程序的時(shí)候,要在括號(hào)里面聲明要從主程序引用的變量和對(duì)象
Public Sub FangGuo(ByVal i As Integer, ByVal xlapp As Excel.Application, ByVal xlbook As Excel.Workbook, ByVal xlsheet As Excel.Worksheet)
'——————————向下為放過區(qū)域——————————————————————
Debug.Print i '即顯信息 '————放過1—————— Select Case ComFgYy1.Text Case "缺邊掉角" xlsheet.Cells(i, "P").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "Q").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "R").Value = Trim(TexFgQk1.Text) Case "變形" xlsheet.Cells(i, "S").Value = Trim(TexFg1P.Text) xlsheet.Cells(i, "T").Value = Trim(TexFg1Kg.Text) xlsheet.Cells(i, "U").Value = Trim(TexFgQk1.Text) end select
End Sub
★點(diǎn)擊窗口右上角的關(guān)閉 是 “unload” 或 “QueryUnload”事件
★子程序改變來自主程序的變量的值: Private Sub Com1_Click() dim CfZ as integer QrCf CfZ If CfZ = 1 Then MsgBox ("放過原因或報(bào)廢原因有重復(fù)!" & vbCrLf & "請(qǐng)查看紅色標(biāo)識(shí)......") End If end sub
Public Sub QrCf(Cf As Integer) Select Case ComFgYy1.Text Case ComFgYy2.Text If ComFgYy1.Text <> "" Then ComFgYy1.BackColor = &HFF& ComFgYy2.BackColor = &HFF& Cf = 1 End If end select end sub
運(yùn)行效果:如果case中Cf=1執(zhí)行,則CfZ的值變?yōu)?,并彈出消息框
★如何判斷字符串為是否為數(shù)字 判斷表達(dá)式的運(yùn)算結(jié)果是否為數(shù)字,返回 Boolean 值(True or False)。
描述 返回 Boolean 值指明表達(dá)式的值是否為數(shù)字。 語法 IsNumeric(expression) expression 參數(shù)可以是任意表達(dá)式。
說明 如果整個(gè) expression 被識(shí)別為數(shù)字,IsNumeric 函數(shù)返回 True;否則函數(shù)返回 False。 如果 expression 是日期表達(dá)式 ,IsNumeric 函數(shù)返回 False。下面的示例利用 IsNumeric 函數(shù)決定變量是否可以作為數(shù)值:
Dim MyVar, MyCheck MyVar = 53 '賦值。 MyCheck = IsNumeric(MyVar) ' 返回 True。
MyVar = "459.95" ' 賦值。 MyCheck = IsNumeric(MyVar) ' 返回True。
MyVar = "45 Help" ' 賦值。 MyCheck = IsNumeric(MyVar) ' 返回 False。
★在frmlogin中設(shè)置用戶及密碼檢查功能 Dim LogIn As Boolean Select Case ComUserName.Text Case "測(cè)試" If txtPassword.Text = "....." Then txtUserName.Text = "測(cè)試" LogIn = True Else LogIn = False End If Case "魏敏" If txtPassword.Text = "wm" Then txtUserName.Text = "魏敏" LogIn = True Else LogIn = False End If Case "黃選華" If txtPassword.Text = "hxh" Then txtUserName.Text = "黃選華" LogIn = True Else LogIn = False End If Case "胡麗萍" If txtPassword.Text = "hlp" Then txtUserName.Text = "胡麗萍" LogIn = True Else LogIn = False End If Case "張嵐" If txtPassword.Text = "zl" Then txtUserName.Text = "張嵐" LogIn = True Else LogIn = False End If Case "馮現(xiàn)萍" If txtPassword.Text = "fxp" Then txtUserName.Text = "馮現(xiàn)萍" LogIn = True Else LogIn = False End If Case "陶學(xué)群" If txtPassword.Text = "txq" Then txtUserName.Text = "陶學(xué)群" LogIn = True Else LogIn = False End If Case "陶明艷" If txtPassword.Text = "tmy" Then txtUserName.Text = "陶明艷" LogIn = True Else LogIn = False End If End Select
★將一個(gè)文件復(fù)制到另外一個(gè)目錄,并改變名字
Dim xlFile, xlFileCopy As String xlFile = App.Path & "\xls\合金廠產(chǎn)品質(zhì)檢明細(xì)表.xls" xlFileCopy = "C:\xlTemp\" & "Copy" & Format(Now, "YYYY_MM_DD_HH_MM_SS") & ".xc" FileCopy xlFile, xlFileCopy
★用format()函數(shù)自定義日期/時(shí)間格式
★VB讀取一個(gè)文件的創(chuàng)建日期: 我看網(wǎng)上找到一個(gè),用fso的 Dim file As Variant Dim fso As Variant Set fso = CreateObject("Scripting.FileSystemObject") Set file = fso.GetFile(.filename) MsgBox vbLf & "創(chuàng)建時(shí)間:" & file.DateCreated & _ vbLf & "修改時(shí)間:" & file.DateLastModified & _ vbLf & "訪問時(shí)間:" & file.DateLastAccessed 另外還有一個(gè)問題,就是獲取文件版本,可以使用 Declare Function GetFileVersionInfo Lib "version.dll" _ Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, _ ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long 但是我對(duì)其中的一些參數(shù)意思不太明白。 lptstrfilename自然是文件的名字,應(yīng)該是包括全路徑的;后面三個(gè)參數(shù)是什么意思我就不太懂了,特別的,最后一個(gè)類型是any,這是什么東東?
★刪除指定位置的普通文件 Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type
Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Const MAX_PATH = 260
Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Dim Fdata As WIN32_FIND_DATA
Private Sub DelFiles(ByVal sPath As String, ByVal xD As String) On Error Resume Next Dim R1 As Long, R2 As Long, TmpTime As String Dim SYSTM As SYSTEMTIME R1 = FindFirstFile(sPath & "*", Fdata) If (Fdata.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = False Then FileTimeToSystemTime Fdata.ftCreationTime, SYSTM TmpTime = CStr(SYSTM.wYear) & "-" & CStr(SYSTM.wMonth) & "-" & CStr(SYSTM.wDay) & " " & CStr(SYSTM.wHour) & ":" & CStr(SYSTM.wMinute) & ":" & CStr(SYSTM.wSecond) If CDate(TmpTime) < CDate(xD) Then Kill sPath & StrF(Fdata.cFileName) End If Do R2 = FindNextFile(R1, Fdata) If R2 = 0 Then Exit Do If (Fdata.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = False Then FileTimeToSystemTime Fdata.ftCreationTime, SYSTM TmpTime = CStr(SYSTM.wYear) & "-" & CStr(SYSTM.wMonth) & "-" & CStr(SYSTM.wDay) & " " & CStr(SYSTM.wHour) & ":" & CStr(SYSTM.wMinute) & ":" & CStr(SYSTM.wSecond) If CDate(TmpTime) < CDate(xD) Then Kill sPath & StrF(Fdata.cFileName)
End If DoEvents Loop End Sub
Private Function StrF(ByVal S As String) As String StrF = Left(S, InStr(S, Chr(0)) - 1) End Function
用法:(刪除“c:\xltemp\”這里所有的10天前的文件) Private Sub Command1_Click() Dim NowDate As String NowDate = Str(Date - 10) DelFiles "c:\xltemp\", NowDate End Sub
(若需要?jiǎng)h除指定擴(kuò)展名的文件,將 R1 = FindFirstFile(sPath & "*", Fdata)這一行里面的 “*” 改成 “*.擴(kuò)展名”) (另外有一點(diǎn),在這個(gè)程序里面,文件的創(chuàng)建時(shí)間是精確到秒的, 你的時(shí)間只用了date-10,只有日期沒時(shí)間, 比如2010-3-10號(hào), 只能刪除10號(hào)之前的。10號(hào)當(dāng)天的刪除不了。)
★VB日期選擇邊框 網(wǎng)上有不少做日期選擇框的方法或控件,搞得非常復(fù)雜。
其實(shí)VB6自帶有日期選擇框的: 菜單:工具,部件 把mcrosoft windows common controls-2 6.0(sp6)
得到的DTPicker就是DateTimePicker 一般就用 DTPicker控件 這就是你想要的東西了
★VB自帶的刪除文件功能
Kill filename
★建立連接用ADO對(duì)象很方便 首先添加“工程-引用”:Microsoft ActiveX Objects 6.0 Library dim cn as new connection dim rs as new recordset cn.open "數(shù)據(jù)庫(kù)連接串" set rs=cn.execute("select * from tab1") debug.print rs.fields("字段名")
("數(shù)據(jù)庫(kù)連接串"這段內(nèi)容,可以用一個(gè)udl文件生成,用記事本創(chuàng)建一個(gè)沒有內(nèi)容的擴(kuò)展名為udl文件,雙擊打開,按上邊的提示配置好,再用記事本打開,就可以找到需要的那段字符串了。)
Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset
Private Sub Command1_Click() cn.ConnectionString = "Provider=MSDASQL.1;Password=.....;Persist Security Info=True;User ID=kio;Data Source=SQLDb;Initial Catalog=DataTest" cn.Open rs.Open "[dbo].[ZJMX]", cn, 1, 3 rs.AddNew rs("登陸時(shí)間") = Text1.Text rs("用戶名") = Text2.Text rs.Update
rs.Clone cn.Close End Sub
★將用戶名和密碼存于數(shù)據(jù)庫(kù)中的數(shù)據(jù)表“用戶設(shè)置”中,下面是密碼驗(yàn)證過程: Cn.ConnectionString = "Provider=SQLOLEDB.1;Password=.....;Persist Security Info=True;User ID=carbide;Initial Catalog=Carbide;Data Source=172.16.13.16\SQLEXPRESS" Cn.Open Dim SqlStr As String SqlStr = "select * from [dbo].[用戶設(shè)置] where [UN]='" & txtUserName.Text & "' And [PW]='" & txtPassword.Text & "'" Set Rs = Cn.Execute(SqlStr) If Not Rs.EOF Then Rs.Close Cn.Close OK = True Me.Hide Else MsgBox "密碼錯(cuò)誤,再試一次!", , "登錄" txtPassword.SetFocus txtPassword.SelStart = 0 txtPassword.SelLength = Len(txtPassword.Text) Rs.Close Cn.Close End If
★SQL 查詢并取值的問題
Cn.ConnectionString = "Provider=SQLOLEDB.1;Password=.....;Persist Security Info=True;User ID=carbide;Initial Catalog=Carbide;Data Source=172.16.13.16\SQLEXPRESS" Cn.Open Dim SqlStr As String SqlStr = "select * from [dbo].[用戶設(shè)置] where [UN]='" & txtUserName.Text & "' And [PW]='" & txtPassword.Text & "'" Set Rs = Cn.Execute(SqlStr) If Not Rs.EOF Then Dlr = Rs("姓名").Value DlID = txtUserName.Text Rs.Close Cn.Close end if
★如何判斷字段值為空 If IsNull(Rs(FgP)) = True And IsNull(Rs(FgKg)) = True Then y = y + 1 GoTo 11 Else ComFgYy(x).Text = Yy(y) TexFgP(x).Text = Rs(FgP).Value TexFgKg(x).Text = Rs(FgKg).Value TexFgQk(x).Text = Rs(FgQk).Value y = y + 1 End If
★更改已有記錄 Cn.Open Dim SqlStr As String SqlStr = "select * from [dbo].[產(chǎn)品質(zhì)檢明細(xì)] where [記錄號(hào)]=" & LshCx Rs.Open SqlStr, Cn, 1, 3
Rs("記錄號(hào)") = LshCx Rs("錄入時(shí)間") = Now Rs("檢驗(yàn)時(shí)間") = DTPJyrq.Value
Rs.update
★刪除已有記錄 Cn.Open Dim SqlStr As String SqlStr = "delete from [dbo].[產(chǎn)品質(zhì)檢明細(xì)] where [記錄號(hào)]=" & LshCx Rs.Open SqlStr, Cn, 1, 3 Cn.Close
★SQL復(fù)制記錄 INSERT INTO `table` SELECT * FROM `table` WHERE id=1; 沒有主鍵時(shí)候才可以。。有主鍵時(shí)候就要寫上列: INSERT INTO `table`(`a`,`b`,`c`) SELECT `a`,`b`,`c` FROM `table` WHERE id=1; 補(bǔ)充:如果要插入數(shù)據(jù)的表比前表字段但是也要插入數(shù)據(jù),可以用mysql函數(shù)產(chǎn)生欄目填充,例如:ABS(1),TRIM('abc')
UPDATE `table` SET a = !a WHERE id = 1;//布爾值取反 UPDATE `table1`,`table2` SET `table1`.id = `table2`.id WHERE `table1`.id = `table2`.id;//更新
★SQL語句查找空值
select * from 表格 where 字段名 is null
★將SQL查找結(jié)果導(dǎo)出到EXCEL Dim xlApp As New Excel.Application Dim xlBook As New Excel.Workbook Dim xlSheet As New Excel.Worksheet Dim m As Integer, n As Integer Dim Ran As String
Set xlApp = CreateObject("Excel.Application") '創(chuàng)建EXCEL應(yīng)用類 Set xlBook = xlApp.Workbooks.Open("f:\softjesen\data\質(zhì)檢明細(xì)100520.xls") '打開EXCEL工作簿 xlApp.Visible = True '設(shè)置EXCEL不可見 Set xlSheet = xlBook.Worksheets.Add ActiveSheet.Name = "產(chǎn)品質(zhì)日?qǐng)?bào)表" & Format(Now, "YYYY_MM_DD_HH_MM_SS") '打開EXCEL工作表 m = 2 Do While Not Rs.EOF For n = 0 To Rs.Fields.Count - 1 Ran = x & ":" & x xlSheet.Cells(1, n + 1) = Rs.Fields(n).Name xlSheet.Cells(m, n + 1) = Rs(n).Value Next Rs.MoveNext m = m + 1 Loop Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing
★VB 中 DataGrid 的使用方法 SqlStr = "select * from dbo.代碼 where [JDE代碼]='" & Trim(Text1(0).Text) & "'" Cn.CursorLocation = adUseClient '關(guān)鍵語句,有了這句控件才能顯示數(shù)據(jù)集的內(nèi)容 Cn.Open 'Rs.Open SqlStr, Cn Set Rs = Cn.Execute(SqlStr) If Not Rs.EOF Then Text1(1).Text = Rs("牌號(hào)") Text1(2).Text = Rs("型號(hào)") Text1(3).Text = Rs("單位") Set DataGrid1.DataSource = Rs '關(guān)鍵語句,將控件和數(shù)據(jù)集連接起來 'DataGrid1.ClearFields 'DataGrid1.ReBind Else MsgBox ("沒有找到對(duì)應(yīng) JDE代碼 的信息!") End If
★ 單擊就全選文本框中內(nèi)容,文本框用到了控件數(shù)組(index= 0 to 8) Private Sub Text1_Click(Index As Integer) Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index).Text) End Sub
★在textbox中顯示 datagrid 表格中選中單元格所在列的記錄 Dim DataBj As Integer '標(biāo)記表中是否有數(shù)據(jù)顯示, 有為 1 沒有 為 0
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) If DataBj = 1 Then Text1(0).Text = DataGrid1.Columns("JDE代碼").Text ' DataGrid1 Text1(1).Text = DataGrid1.Columns("牌號(hào)").Text 'rs1("牌號(hào)") Text1(2).Text = DataGrid1.Columns("型號(hào)").Text 'rs1("型號(hào)") Text1(3).Text = DataGrid1.Columns("說明").Text 'rs1("說明").Value Text1(4).Text = DataGrid1.Columns("備注").Text 'rs1("備注").Value Combo1.Text = DataGrid1.Columns("單位").Text 'rs1("單位") ID = DataGrid1.Columns("ID").Text 'rs1("ID").Value End If
注意:DataGrid1_RowColChange 事件在datagrid控件中的內(nèi)容有改變的時(shí)候都會(huì)被激活,所以在查詢結(jié)果顯示出來之前該事件就被激活了,會(huì)出現(xiàn)好不到記錄的提示,為了解決這個(gè)問題,需要引入一個(gè)變量DataBj 來標(biāo)記是否已經(jīng)有查詢結(jié)果顯示在表格中,使當(dāng)表格中有內(nèi)容的時(shí)候才執(zhí)行DataGrid1_RowColChange事件中的代碼。
★通過SQL語句刪除表中重復(fù)記錄的方法 原理:曬出無重復(fù)的記錄 將數(shù)據(jù)導(dǎo)入到另外一個(gè)相同的表中(名字不同),再將無重復(fù)記錄的表的名字改為源表的名字。 INSERT INTO DBO.代碼2 ([ID],[JDE代碼],[牌號(hào)],[型號(hào)],[單位],[說明]) SELECT DISTINCT [ID],[JDE代碼],[牌號(hào)],[型號(hào)],[單位],[說明] FROM dbo.代碼
★定時(shí)任務(wù),使用 Timer控件,在Timer控件的interval屬性中設(shè)置時(shí)間間隔, 單位是 毫秒 (1秒=1000毫秒)
例:Private Sub Timer1_Timer() rs.Requery DataGrid1.refresh End Sub
★如何獲得查詢結(jié)果的 記錄條數(shù) X = Rs.RecordCount 'X就是記錄的條數(shù)
vb中recordcount返回值總是為-1:
這樣就沒問題rs.open sqlstr,conn,3,2 這樣就有問題rs.open sqlstr,conn,1,2 因?yàn)閏onn后第一個(gè)數(shù)字是1表示指針只能往前,3表示自由指針 使用RecordCount屬性可確定Recordset對(duì)象中記錄的數(shù)目。ADO無法確定記錄數(shù)時(shí),或者如果提供者或游標(biāo)類型不支持RecordCount,則該屬性返回–1。讀已關(guān)閉的Recordset上的RecordCount屬性將產(chǎn)生錯(cuò)誤。 如果Recordset對(duì)象支持近似定位或書簽(即Supports(adApproxPosition)或Supports(adBookmark)各自返回True),不管是否完全填充該值,該值將為Recordset中記錄的精確數(shù)目。如果Recordset對(duì)象不支持近似定位,該屬性可能由于必須對(duì)所有記錄進(jìn)行檢索和計(jì)數(shù)以返回精確RecordCount值而嚴(yán)重消耗資源。 Recordset對(duì)象的游標(biāo)類型會(huì)影響是否能夠確定記錄的數(shù)目。對(duì)僅向前游標(biāo),RecordCount屬性將返回-1,對(duì)靜態(tài)或鍵集游標(biāo)返回實(shí)際計(jì)數(shù),對(duì)動(dòng)態(tài)游標(biāo)取決于數(shù)據(jù)源返回-1或?qū)嶋H計(jì)數(shù)。
★關(guān)閉當(dāng)前窗口的代碼 Unload Me
★ ★ ★ ★ ★ ★
|