需求:
A1中放一个Dropdownlist,B1放一个button,点击button后从数据库读取数据绑定到Dropdownlist,选择任一item后,再去数据库读取对应内容展示出来
Sub btnList_Click() ActiveSheet.Range("5:65536").ClearContents Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim cmd As New ADODB.Command Dim sqlText As String Dim Row As Long Dim Findex As Long conn.Open "DSN=Oracle;;DBQ=ORAPRDPIM;......" cmd.ActiveConnection = conn cmd.CommandType = adCmdText sqlText = "SELECT DISTINCT ult_parent_name FROM pm_own.hy_master_exposure_sdb e, pm_own.sec_risk_measures srm WHERE srm.ssm_id = e.cusip AND e.comp_sec_type_code NOT IN ('ABS','TSY') ORDER BY ult_parent_name " cmd.CommandText = sqlText Set rs = cmd.Execute On Error GoTo ErrorHandler ActiveSheet.DropDowns("ddlUltParent").Delete ErrorHandler: 'do nothing Resume Next ActiveSheet.DropDowns.Add(Range("A1").Left, Range("A1").Top, 240, 18).Select With Selection .Name = "ddlUltParent" .OnAction = "ddlUltParent_SelectionChanged" Do While Not rs.EOF Row = Row + 1 .AddItem rs.Fields(0).Value, Row rs.MoveNext Loop .DropDownLines = 50 End With ActiveSheet.Range("A1").Select conn.Close End Sub Public Sub ddlUltParent_SelectionChanged() 'Sheets("Sheet1").Range("5:65536").ClearContents ActiveSheet.Range("5:65536").ClearContents Dim selectIndex As Integer Dim selectText As String Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim cmd As New ADODB.Command Dim sqlText As String Dim data As Worksheet Dim dd As DropDown Set dd = ActiveSheet.DropDowns("ddlUltParent") 'Set data = Sheets("Sheet1") Set data = ActiveSheet selectIndex = ActiveSheet.DropDowns("ddlUltParent").Value selectText = dd.List(selectIndex) conn.Open "DSN=Oracle;;DBQ=ORAPRDPIM;......" cmd.ActiveConnection = conn cmd.CommandType = adCmdText sqlText1 = "SELECT e.acct_no, e.acct_name, e.mgr_name, e.cusip, e.isin, e.description," sqltext2 = "e.coupon, e.maturity, e.price, e.quantity, e.bond_exposure," sqltext3 = "AND e.ult_parent_name = '" + selectText + "'" sqlText = sqlText1 + sqltext2 + sqltext3 cmd.CommandText = sqlText Set rs = cmd.Execute Row = 5 For X = 1 To rs.Fields.Count data.Cells(Row, X).Value = rs.Fields(X - 1).Name Next Do While Not rs.EOF Row = Row + 1 For Findex = 0 To rs.Fields.Count - 1 data.Cells(Row, Findex + 1).Value = rs.Fields(Findex).Value Next Findex rs.MoveNext Loop End Sub