![]() |
|
|
|
#1
|
||||
|
||||
|
Code:
Option Explicit Private Sub CANCELbutton_Click() Me.Hide Me.Tag = 0 End Sub Private Sub OKbutton_Click() Me.Hide Me.Tag = 1 End Sub The parts that you added to the above go in the code that calls the userform e.g. as follows. The Excel function also goes in the same module as Sub Main. Code:
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 'Cancel was selected
ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Text
End With
lbl_Exit:
Unload oFrm
Set oFrm = Nothing
Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
#2
|
|||
|
|||
|
Quote:
I'll give it a try. |
|
#3
|
|||
|
|||
|
Quote:
![]() It's working great! Thanks a lot. ![]() I have one final issue I was hoping I could figure out on my own but I'm not having any luck. Maybe you can offer a suggestion or two? ![]() Below is the sample table I am using in Excel. Currently the range include all three columns. ![]() Populating the "Drawing Number" using this code... Code:
ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Text
Any suggestions or links to your web site where you cover this would be greatly appreciated. As always, thanks for your help.
|
|
#4
|
|||
|
|||
|
Graham (or anyone else),
I need some assistance on how I would modify the following code so I could use an Access (Access 2016) database as my data source to populate content controls. Any information, be it code or links, will be appreciated. Code:
Sub Main()
Dim oFrm As New DrawingNumberEntryForm 'userform to retrieve initial drawing number
With oFrm
xlFillList ListOrComboBox:=.DrawingNumberUf, _
iColumn:=1, _
strWorkbook:="C:\Temp\ItemSheet2.xlsx", _
strRange:="TableXXX", _
RangeIsWorksheet:=False, _
RangeIncludesHeaderRow:=True
.Show
If .Tag = 0 Then GoTo lbl_Exit 'Cancel was selected
'ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Text
If .DrawingNumberUf.Column(3) = "N" Then
ActiveDocument.Unprotect '("PreciseTF")
ActiveDocument.Tables(2).Delete
ActiveDocument.SelectContentControlsByTitle("Cert Type").Item(1).Range.Text = .DrawingNumberUf.Column(4)
ActiveDocument.Protect NoReset:=True, Password:="", Type:=wdAllowOnlyFormFields
End If
ActiveDocument.SelectContentControlsByTitle("Drawing Number").Item(1).Range.Text = .DrawingNumberUf.Column(0)
ActiveDocument.SelectContentControlsByTitle("Revision").Item(1).Range.Text = .DrawingNumberUf.Column(1)
ActiveDocument.SelectContentControlsByTitle("Part Description").Item(1).Range.Text = .DrawingNumberUf.Column(2)
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)
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
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
|
|
| 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 |