![]() |
#5
|
||||
|
||||
![]()
Actually you are doing nothing wrong. The error was mine. The code has lost a line
![]() I'll fix it on the web site, but in the meantime, I have corrected it below. The userform primarily needs code to set a Tag of 0 for cancel and 1 for proceeding associated with the command buttons and in both cases to hide the form e.g. Code:
Option Explicit Private Sub btnOK_Click() Me.Hide Me.Tag = 1 End Sub Private Sub btnCancel_Click() Me.Hide Me.Tag = 0 End Sub Code:
Option Explicit Private RS As Object Private CN As Object Private numrecs As Long, q As Long Private strWidth As String Sub Main() Dim oFrm As New DrawingNumberEntryForm With oFrm xlFillList ListOrComboBox:=.DrawingNumberUf, _ iColumn:=1, _ strWorkbook:="C:\Temp\ItemSheet.xlsx", _ strRange:="CollRange", _ RangeIsWorksheet:=False, _ RangeIncludesHeaderRow:=True .Show If .Tag = 0 Then GoTo lbl_Exit 'Do stuff with ofrm End With lbl_Exit: Unload oFrm Set oFrm = Nothing Exit Sub End Sub Private Function xlFillList(ListOrComboBox As Object, _ iColumn As Long, _ strWorkbook As String, _ strRange As String, _ RangeIsWorksheet As Boolean, _ RangeIncludesHeaderRow As Boolean, _ Optional PromptText As String = "[Select Item]") If RangeIsWorksheet = True Then strRange = strRange & "$]" Else strRange = strRange & "]" End If Set CN = CreateObject("ADODB.Connection") If RangeIncludesHeaderRow Then CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & strWorkbook & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=YES"";" Else CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & strWorkbook & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=NO"";" End If Set RS = CreateObject("ADODB.Recordset") RS.CursorLocation = 3 RS.Open "SELECT * FROM [" & strRange, CN, 2, 1 'read the data from the worksheet With RS .MoveLast numrecs = .RecordCount .MoveFirst End With With ListOrComboBox .ColumnCount = RS.Fields.Count If RS.RecordCount > 0 Then .Column = RS.GetRows(numrecs) End If strWidth = vbNullString For q = 1 To .ColumnCount If q = iColumn Then If strWidth = vbNullString Then strWidth = .Width - 4 & " pt" Else strWidth = strWidth & .Width - 4 & " pt" End If Else strWidth = strWidth & "0 pt" End If If q < .ColumnCount Then strWidth = strWidth & ";" End If Next q .ColumnWidths = strWidth If TypeName(ListOrComboBox) = "ComboBox" Then .AddItem PromptText, 0 If Not iColumn - 1 = 0 Then .Column(iColumn - 1, 0) = PromptText .ListIndex = 0 End If End With 'Cleanup If RS.State = 1 Then RS.Close Set RS = Nothing If CN.State = 1 Then CN.Close Set CN = Nothing lbl_Exit: Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Tags |
combobox, populate, userform |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Shane.Hutchison | Excel Programming | 1 | 10-22-2015 12:24 PM |
Help!! Dropdown List | christo16 | Word | 1 | 06-29-2015 05:18 AM |
Dropdown list, Macro | shield5 | Excel Programming | 7 | 10-27-2013 01:51 AM |
![]() |
antztaylor | Word | 3 | 11-06-2012 05:46 PM |
![]() |
Billy_McSkintos | Word VBA | 1 | 09-13-2011 05:50 AM |