Quote:
Originally Posted by gmayor
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.
|
Graham,
Here is my userform after I added your updated code...
Code:
Option Explicit
Private RS As Object
Private CN As Object
Private numrecs As Long, q As Long
Private strWidth As String
Private Sub CANCELbutton_Click()
Me.Hide
Me.Tag = 0
Application.Quit
End Sub
Private Sub OKbutton_Click()
ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = DrawingNumberUf
Me.Hide
Me.Tag = 1
lbl_Exit:
Unload Me
Exit Sub
End Sub
Sub Main()
Dim oFrm As New DrawingNumberEntryForm
With oFrm
xlFillList ListOrComboBox:=.DrawingNumberUf, _
iColumn:=1, _
strWorkbook:="C:\Temp\ItemSheet.xlsx", _
strRange:="Table1", _
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
Unfortunately, the combobox still isn't populating. Was I supposed to put all the code in the userform or the "Sub Main()" in the main document? (The form that actually calls the userform.)
I appreciate your help. I really am learning a lot thanks to you and others.