VBA——SQL语句窗体控件运用
2020-04-09 本文已影响0人
猛犸象和剑齿虎

这个例子是受到EXCELHOME一位大佬启发制作的。
不知道各位道友发现没有,在EXCEL中用其自带的数据连接功能写SQL,时常会出现数据连接问题,本意是想写一个厉害的SQL把很多工作变成打开报表刷新数据的工作,实际上由于连接问题不得不一次次修复连接问题。
而用VBA把SQL语句写入是十分方便有效,而且更进一步可以把写过的SQL用一个窗体载入,大大简化了操作,再不用ALT+D+D+D了。

代码部分:
Private Sub ComboBox1_Change()
ComboBox2.ListIndex = ComboBox1.ListIndex
Set c = Sheets("SQL语句").Range("A:A").Find(Left(ComboBox1.Text, 15), , lookat:=xlWhole)
If Not c Is Nothing Then TextBox1.Text = Sheets("SQL语句").Cells(c.Row, 2)
End Sub
Private Sub ComboBox2_Change()
ComboBox2.ListIndex = ComboBox1.ListIndex
Set c = Sheets("SQL语句").Range("A:A").Find(Left(ComboBox1.Text, 15), , lookat:=xlWhole)
If Not c Is Nothing Then TextBox1.Text = Sheets("SQL语句").Cells(c.Row, 2)
End Sub
Private Sub CommandButton1_Click()
'On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim cnn, sql$
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
sql = ComboBox1.Text
Set rs = cnn.Execute(sql)
Sheets("结果").Cells.ClearContents
For i = 1 To rs.Fields.Count
Sheets("结果").Cells(1, i) = rs.Fields(i - 1).Name
Next
Sheets("结果").Range("a2").CopyFromRecordset rs
cnn.Close
Set cnn = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub Label3_Click()
End Sub
Private Sub UserForm_Initialize()
Set sh = Sheets("SQL语句")
For i = 2 To 20
ComboBox1.AddItem sh.Cells(i, 1).Value
ComboBox2.AddItem sh.Cells(i, 3).Value
Next i
Sheets("结果").Activate
End Sub
由于find对字符数量是有限制的(可以试试),具体多少并不清楚,所以用LEFT函数截取了15个字符,来定位单元格,当然这个功能可有可无,毕竟写的SQL并不多。