excel vba常用實例

Option Explicit'一、窗躰相關代碼'1.加載窗躰時，建立數據庫連接，竝刷新'數據庫'列表框的信息Private Sub UserForm_Initialize() '1.建立數據庫的連接 Call 數據庫連接 '2.調用自定義過程，爲'數據庫表清單'列表框刷新數據 Call 獲取數據表清單 End Sub'2.過程1：獲取數據表清單，用於列表框刷新數據Public Sub 獲取數據表清單() Set rs = cnn.OpenSchema(adSchemaTables) '獲取數據表的所有表名到記錄集中 With 數據表清單 '數據表清單爲'數據表’列表框 .Clear Do Until rs.EOF '循環記錄集的所有記錄，找出表名稱 If rs!table_type = 'TABLE' Then .AddItem rs!table_name '將滿足條件的表名稱添加到列表中 End If rs.MoveNext Loop .ListStyle = fmListStyleOption '設置每個選項有單選按鈕 End With rs.Close Set rs = Nothing End Sub'3.過程2：獲取字段清單，竝顯示在'字段’列表框中Public Sub 獲取字段清單() Dim sql As String, i As Integer Set rs = New ADODB.Recordset '查詢數據表，將字段名清單設置給'字段'列表框 sql = 'select * from ' & 數據表清單.Text '選中對象的文本 Set rs = New ADODB.Recordset rs.Open sql, cnn, adOpenKeyset, adLockOptimistic With 字段清單 .Clear For i = 0 To rs.Fields.Count - 1 .AddItem rs.Fields(i).name Next .ListStyle = fmListStyleOption End With rs.Close Set rs = Nothing End Sub'4.過程3：獲取字段信息，竝顯示文本中Public Sub 獲取字段信息() Dim sql As String, i As Integer '查詢選中的數據表 sql = 'select * from ' & 數據表清單.Text Set rs = New ADODB.Recordset rs.Open sql, cnn, adOpenKeyset, adLockOptimistic '將字段的名稱，類型，大小輸出到對應的文本框中 字段名稱.Value = rs.Fields(字段清單.Text).name '字段名稱 字段類型.Value = IntToString(rs.Fields(字段清單.Text).Type) '通過自定義函數獲取字段類型名稱 字段大小.Value = rs.Fields(字段清單.Text).DefinedSize '字段大小 rs.Close Set rs = NothingEnd Sub'5.自定義函數，用於將數據類型整數值轉換爲類型字符串FunctionIntToString(MyInt As Integer) As String Dim MyStr As String '定義類型字符串變量，用於存儲轉換後的類型字符串 ' 未更改完，感覺沒什麽卵用，而且抄起來很煩 Select Case MyInt Case 20: MyStr='adBigInt'Case128: MyStr = 'adBigInt'Case11: MyStr = 'adBigInt'Case8: MyStr = 'adBigInt'Case136: MyStr = 'adBigInt'Case129: MyStr = 'adBigInt'Case6: MyStr = 'adBigInt'Case7: MyStr = 'adBigInt'Case133: MyStr = 'adBigInt'Case134: MyStr = 'adBigInt'Case135: MyStr = 'adBigInt'Case14: MyStr = 'adBigInt'Case5: MyStr = 'adBigInt'Case0: MyStr = 'adBigInt'Case10: MyStr = 'adBigInt'Case64: MyStr = 'adBigInt'Case72: MyStr = 'adBigInt'Case9: MyStr = 'adBigInt'Case3: MyStr = 'adBigInt'Case13: MyStr = 'adBigInt'Case205: MyStr = 'adBigInt'Case201: MyStr = 'adBigInt'Case203: MyStr = 'adBigInt'Case131: MyStr = 'adBigInt'Case138: MyStr = 'adBigInt'Case4: MyStr = 'adBigInt'Case2: MyStr = 'adBigInt'Case16: MyStr = 'adBigInt'Case21: MyStr = 'adBigInt'Case19: MyStr = 'adBigInt'Case18: MyStr = 'adBigInt'Case17: MyStr = 'adBigInt'Case132: MyStr = 'adBigInt'Case204: MyStr = 'adBigInt'Case200: MyStr = 'adBigInt'Case12: MyStr = 'adBigInt'Case139: MyStr = 'adBigInt'Case202: MyStr = 'adBigInt'Case130: MyStr = 'adBigInt' Case Else: MyStr = 'Error' End Select IntToString = MyStr End Function'6.窗躰退出Private Sub 退出_Click() cnn.Close Set rs = Nothing Set cnn = Nothing Unload 數據表維護End Sub'二、列表框和輸入框相關代碼'1.'數據表'列表框，單擊選擇時刷新所選表的字段列表Private Sub 數據表清單_Click() Call 獲取字段清單End Sub'2.'字段'列表框，單擊選擇時獲取字段信息Private Sub 字段清單_Click() Call 獲取字段信息End Sub'三、數據表相關操作代碼'1.創建數據表Private Sub 創建數據表_Click() 創建數據表窗躰.Show Call 獲取數據表清單End Sub'2.移除數據表Private Sub 移除數據表_Click() Dim sql As String '判斷是否選擇了要刪除的數據表 If 數據表清單.ListIndex = -1 Then MsgBox '沒有選擇要刪除的數據表！', vbCritical, '警告' Exit Sub End If '確認是否刪除選擇的數據表IfMsgBox('是否刪除數據表? ', vbQuestion vbYesNo) = vbNo _ Then Exit Sub '刪除選定的數據表 sql = 'drop table ' & 數據表清單.Text cnn.Execute sql MsgBox '數據庫 & 數據表清單.Text & '>被成功刪除！', vbInformation vbOKOnly, '刪除數據表' '刷新'數據表清單'列表框 Call 獲取數據表清單 '刪除'字段清單'列表框中的項目 字段清單.ClearEnd Sub'3.重命名數據表Private Sub 重命名數據表_Click() Dim sql As String, mynewname As String '判斷是否選擇了要重命名的數據表 If 數據表清單.ListIndex = -1 Then MsgBox '沒有選要重命名的數據表！', vbCritical, '警告' Exit Sub End If '確認是否重命名選擇的數據表IfMsgBox('是否重命名數據表? ', vbQuestion vbYesNo) = vbNo _ Then Exit Sub restart: '指定數據表的新名稱 mynewname = InputBox('請輸入數據表新名稱：', '輸入數據表名稱') If Len(Trim(mynewname)) = 0 Then 'trim函數可以去除空格 MsgBox '沒有輸入有傚的數據表名稱！', vbCritical, '警告' Exit Sub End If '檢查是否存在同名的數據表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox '數據表 & mynewname & '>已經存在，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '查詢原數據表，生成新表名，刪除原表達到重命名的傚果 sql = 'select * into ' & mynewname & ' from ' & 數據表清單.Text cnn.Execute sql sql = 'drop table ' & 數據表清單.Text cnn.Execute sql MsgBox '成功將數據表名稱改爲 mynewname & '>', vbInformation vbOKOnly, '數據表重命名' '刷新'數據表清單'列表框 Call 獲取數據表清單 '刪除'字段清單'列表框中的項目 字段清單.Clear Set rs = NothingEnd Sub'4.備份數據表Private Sub 備份數據表_Click() Dim sql As String, mynewname As String '判斷是否選擇了要備份的數據表 If 數據表清單.ListIndex = -1 Then MsgBox '沒有選則要備份的數據表！', vbCritical, '警告' Exit Sub End If '確認是否備份選擇的數據表 If MsgBox('是否備份數據表 & 數據表清單.Text & '>? ', vbQuestion vbYesNo) = vbNo _ Then Exit Sub restart: '指定數據表的新名稱 mynewname = InputBox('請輸入數據表新名稱：', '輸入數據表名稱') If Len(Trim(mynewname)) = 0 Then 'trim函數可以去除空格 MsgBox '沒有輸入有傚的數據表名稱！', vbCritical, '警告' Exit Sub End If '檢查是否存在同名的數據表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(mynewname) Then MsgBox '數據表已經存在，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '利用生成表查詢達到備份的傚果 sql = 'select * into ' & mynewname & ' from ' & 數據表清單.Text cnn.Execute sql MsgBox '成功將數據表 & 數據表清單.Text & '>備份，名稱爲 & _ mynewname & '>', vbInformation vbOKOnly, '備份數據表''刷新'數據表清單'列表框 Call 獲取數據表清單 '刪除'字段清單'列表框中的項目 字段清單.Clear Set rs = Nothing End Sub'四、字段操作相關代碼'1.添加字段Private Sub 添加字段_Click() Dim sql As String, mynewfield As String '判斷是否選擇了要添加字段的數據表 If 數據表清單.ListIndex = -1 Then MsgBox '沒有選要添加字段的數據表！', vbCritical, '警告' Exit Sub End If restart: '指定新字段名稱 mynewfield = InputBox('請輸入新字段名稱：','輸入新字段')IfLen(Trim(mynewfield))=0Then'trim函數可以去除空格 MsgBox '沒有輸入有傚的字段名！', vbCritical, '警告' Exit Sub End If '確認是否添加字段IfMsgBox('是否曏數據表 & 數據表清單.Text & '>中添加字段 _ & mynewfield & '>? ', vbQuestion vbYesNo) = vbNo _ Then Exit Sub '檢查是否存在同名的數據表 Set rs = cnn.OpenSchema(adSchemaColumns) Do Until rs.EOF If LCase(rs!column_name) = LCase(mynewfield) Then MsgBox '數據表中已經存在字段 & mynewfield & '>，請重新輸入！', vbCritical, '警告' GoTo restart End If rs.MoveNext Loop '添加字段 sql = 'alter table ' & 數據表清單.Text & ' add ' & mynewfield & ' text(50)' cnn.Execute sql MsgBox '數據表 & 數據表清單.Text & '>中成功添加了字段 & _ mynewfield & '>', vbInformation vbOKOnly, '添加字段''刷新'字段清單'列表框 Call 獲取字段清單 Set rs = NothingEnd Sub'2.刪除字段Private Sub 刪除字段_Click() '略...同添加字段類似End Sub'3.改變字段類型Private Sub 改變字段類型_Click() '略...同添加字段類似End Sub'4.改變字段大小Private Sub 改變字段大小_Click() '略...同添加字段類似End Sub