![]() |
|
#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 |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Excel List Box not populating worksheet field upon submit
|
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 |
Need help populating dropdown box
|
antztaylor | Word | 3 | 11-06-2012 05:46 PM |
Populating ComboBox or Drop Down list with contents of a text field
|
Billy_McSkintos | Word VBA | 1 | 09-13-2011 05:50 AM |