#1
|
|||
|
|||
Import list from Excel into drop-down content control in word
Hi!
I realized if the excel (where we import the excel column as a simple word dropdown list) has "blank" fields which could be due to users deleting text from a cell instead of deleting the entire row, there may be a "Runtime Error 94: Invalid use of NULL," when we open the word macro document. Instead of writing a macro in excel to delete all blank fields, is there a method where we can manipulate the vba code in word to ignore all blank fields from the excel list? I'm using a sample code from Mr Gregory's webpage "https://gregmaxey.com/word_tip_pages/import_excel_list_into_word_dropdownlist.html" as shown below: Private Function fcnExcelDataToArray(strWorkbook As String, _ Optional strRange As String = "Sheet1", _ Optional bIsSheet As Boolean = True, _ Optional bHeaderRow As Boolean = True) As Variant 'Default parameters include "Sheet1" as the named sheet, range of the full named sheet _ and a header row is used. Dim oRS As Object, oConn As Object Dim lngRows As Long Dim strHeaderYES_NO As String strHeaderYES_NO = "YES" If Not bHeaderRow Then strHeaderYES_NO = "NO" If bIsSheet Then strRange = strRange & "$]" Else strRange = strRange & "]" Set oConn = CreateObject("ADODB.Connection") oConn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12 .0;" & _ "Data Source=" & strWorkbook & ";" & _ "Extended Properties=""Excel 12.0 Xml;HDR=" & strHeaderYES_NO & """;" Set oRS = CreateObject("ADODB.Recordset") oRS.Open "SELECT * FROM [" & strRange, oConn, 2, 1 With oRS .MoveLast lngRows = .RecordCount .MoveFirst End With fcnExcelDataToArray = oRS.GetRows(lngRows) lbl_Exit: If oRS.State = 1 Then oRS.Close Set oRS = Nothing If oConn.State = 1 Then oConn.Close Set oConn = Nothing Exit Function End Function Sub Document_Open() Dim strWorkbook As String Dim lngIndex As Long Dim arrData As Variant Dim oCC As ContentControl, oFF As FormField Dim bReprotect As Boolean Application.ScreenUpdating = False 'The Excel file defining the simple list. Change to suit. strWorkbook = ThisDocument.Path & "\Excel Data Store.xlsx" If Dir(strWorkbook) = "" Then MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation Exit Sub End If 'Get the data. Change sheet name to suit. arrData = fcnExcelDataToArray(strWorkbook, "Simple List") Set oCC = ActiveDocument.SelectContentControlsByTitle("CC Dropdown List").Item(1) 'Populate the CC If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else 'Assumes no placeholder entry. Simple clear list. oCC.DropdownListEntries.Clear End If For lngIndex = 0 To UBound(arrData, 2) oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(0, lngIndex) Next lbl_Exit: Application.ScreenUpdating = True Exit Sub End Sub Thanks! |
#2
|
|||
|
|||
Perhaps:
For lngIndex = 0 To UBound(arrData, 2) If Not IsNull(UBound(arrData, 2) then oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(0, lngIndex) End If Next |
#3
|
|||
|
|||
Quote:
'Get the data. Change sheet name to suit. arrData1 = fcnExcelDataToArray(strWorkbook, "Simple List") Set oCC = ActiveDocument.SelectContentControlsByTitle("CC Dropdown List").Item(1) 'Populate the CC If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else 'Assumes no placeholder entry. Simple clear list. oCC.DropdownListEntries.Clear End If For lngIndex = 0 To UBound(arrData1, 2) If Not IsNull(UBound(arrData1, 2)) Then oCC.DropdownListEntries.Add arrData1(0, lngIndex), arrData1(0, lngIndex) End If Next However, I got an error highlighting the line "oCC.DropdownListEntries.Add arrData1(0, lngIndex), arrData1(0, lngIndex)". The error is Run-time error '6215' An entry with the same display name already exists - each entry must specify a display name. I have other dropdown lists which I named them as arrData2, arrData3 etc to create a few simple dropdown list but I didn't have that error earlier. Able to advise? Thanks. |
#4
|
|||
|
|||
Hi Greg,
I realised I accidentally added a duplicate value in one of my excel sheets, hence the "display name already exist" error. However, I'm still getting the "invalid use of null" error. The line in bold below is the line with error. Was just wondering if the indentation affects how the code runs? For lngIndex = 0 To UBound(arrData1, 2) If Not IsNull(UBound(arrData1, 2)) Then oCC.DropdownListEntries.Add arrData1(0, lngIndex), arrData1(0, lngIndex) End If Next |
#5
|
||||
|
||||
Since you are adding the value
arrData1(0, lngIndex) wouldn't it make sense to test if that is null rather than the value of UBound(arrData1, 2) which won't change during each step of the For/Next loop
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
Quote:
Thanks for your reply. Don't really get what you mean. But now I'm trying to remove all blank fields from the source data (excel) instead. However, instead of removing blank fields from just 1 sheet, I would like to loop through the entire worksheet and remove every blank field from every sheet. My excel vba code is as follows. However, this code only allows blank fields from the 'active sheet' to be removed whereas the blank fields from other sheets will not be removed. Able to advise? Sub WorksheetLoop() ' Declare Current as a worksheet object variable. Dim Current As Worksheet ' Loop through all of the worksheets in the active workbook. For Each Current In Worksheets ' Insert your code here. On Error Resume Next Range("A2:A" & Current.UsedRange.Rows.Count).SpecialCells(xlCellT ypeBlanks).EntireRow.Delete ' This line displays the worksheet name in a message box. MsgBox Current.Name Next End Sub |
#7
|
|||
|
|||
Quote:
I have another issue with the simple word dropdown list. I have 3 tables with 3 identical word dropdown lists that needs to be updated from a particular excel sheet e.g. 'Sheet 1'. In order for the fields in all 3 word dropdown lists to be updated correctly when I update 'Sheet 1' , I have to create 3 drop-down lists, each with a unique content control name e.g. arrData1 with content control title 'Dropdown List 1', arrData2 with content control title 'Dropdown List 2', and arrData3 'Dropdown List 3 (see extract of code below). However, the user may not necessarily be using all 3 tables. He can delete 2 tables, but he will minimally fill in at least one of the 3 tables. If the tables (with the content controls) are deleted in the word document main page, there will be an error because some of the codes for the content control dropdown list written in the visual basic editor cannot be found in the word document main page. Is there any method to modify the code such that if any of the codes for the dropdown list (e.g. Dropdown List 1 and Dropdown List 3) is written in the visual basic editor but cannot be found in the word document main page, to ignore this error? Apologies for the long description and hope this is understandable! arrData1 = fcnExcelDataToArray(strWorkbook, "Sheet 1") Set oCC = ActiveDocument.SelectContentControlsByTitle("Dropd own List 1").Item(1) 'Populate the CC If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else 'Assumes no placeholder entry. Simple clear list. oCC.DropdownListEntries.Clear End If For lngIndex = 0 To UBound(arrData1, 2) oCC.DropdownListEntries.Add arrData1(0, lngIndex), arrData1(0, lngIndex) Next arrData2 = fcnExcelDataToArray(strWorkbook, "Sheet 1") Set oCC = ActiveDocument.SelectContentControlsByTitle("Dropd own List 2").Item(1) 'Populate the CC If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else 'Assumes no placeholder entry. Simple clear list. oCC.DropdownListEntries.Clear End If For lngIndex = 0 To UBound(arrData2, 2) oCC.DropdownListEntries.Add arrData2(0, lngIndex), arrData2(0, lngIndex) Next arrData3 = fcnExcelDataToArray(strWorkbook, "Sheet 1") Set oCC = ActiveDocument.SelectContentControlsByTitle("Dropd own List 3").Item(1) 'Populate the CC If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else 'Assumes no placeholder entry. Simple clear list. oCC.DropdownListEntries.Clear End If For lngIndex = 0 To UBound(arrData3, 2) oCC.DropdownListEntries.Add arrData3(0, lngIndex), arrData3(0, lngIndex) Next |
#8
|
||||
|
||||
Can you post sample Word and Excel files that we can test your code on. If you want help that works with specific examples then we need to see those as well.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
Hi!
I have uploaded the dotm word file and the excel where the data for the simple word dropdown list is stored. As mentioned, I have 3 identical tables. For each table under column 3, I have a simple dropdown list. The user has the flexibility to delete any of the tables depending on whether he needs the table. However, when any of the tables are deleted, there will be an error "Run-time error '5941':The requested member of the collection does not exist". Hence I was wondering, if there is any way to modify the code such that if e.g. Dropdown List 1 or Dropdown List 2 or Dropdown List 3 does not exist, ignore and go to the next line of code. I think it's similar to Python's "try, except, pass" method but I don't know how to write it on word VBA. I tried to add "On Error Resume Next" to my word VBA code but it doesn't work. Hope this clarifies! Thanks. |
#10
|
||||
|
||||
Rather than test to see if a Content Control exists, you can loop through a specific group of Content Controls. So if the member of the group doesn't exist then there is no error and no need to check if it exists.
I've set the Tag property on each of the CC to "Simple List" but left the Title Property untouched as a differentiator. Code:
Sub Document_Open() 'The script below is to populate the simple List Dim strWorkbook As String, lngIndex As Long, arrData As Variant Dim oCC As ContentControl, oFF As FormField, bReprotect As Boolean Application.ScreenUpdating = False 'The Excel file defining the simple list. Change to suit. strWorkbook = ThisDocument.Path & "\Excel Data Store.xlsx" If Dir(strWorkbook) = "" Then MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation Exit Sub End If 'Clear simple lists For Each oCC In ActiveDocument.SelectContentControlsByTag("Simple List") If oCC.DropdownListEntries.Item(1).Value = vbNullString Then 'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _ Preserve the placeholder entry. For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1 oCC.DropdownListEntries.Item(lngIndex).Delete Next lngIndex Else oCC.DropdownListEntries.Clear 'Assumes no placeholder entry. Simple clear list. End If 'chose the relevant array source If oCC.Title = "Dropdown List 1" Then arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1") ElseIf oCC.Title = "Dropdown List 2" Then arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1") Else arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1") End If 'Write array to list entries For lngIndex = 0 To UBound(arrData, 2) oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(0, lngIndex) Next Next oCC lbl_Exit: Application.ScreenUpdating = True Exit Sub End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#11
|
|||
|
|||
Quote:
Dear Guessed, I just tried this and it works perfectly for me! Thank you very much! Separately, do you have a solution to my earlier question on writing an excel VBA code to remove all blank cells and duplicates in all sheets of an excel workbook? This was my earlier code as shared (see below) but this was to remove blank cells only. Now, I wanted to remove the duplicates as well. Sub WorksheetLoop() ' Declare Current as a worksheet object variable. Dim Current As Worksheet ' Loop through all of the worksheets in the active workbook. For Each Current In Worksheets ' Insert your code here. On Error Resume Next Range("A2:A" & Current.UsedRange.Rows.Count).SpecialCells(xlCellT ypeBlanks).EntireRow.Delete ' This line displays the worksheet name in a message box. MsgBox Current.Name Next End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to import list from Excel into drop-down list into word | ahw | Word VBA | 43 | 02-28-2020 08:11 PM |
Assigning Macro to Drop Down list Content Control | aussiew | Word VBA | 5 | 03-10-2019 02:55 PM |
Export Word Drop-Down Content Control to Excel Specific Sheet | nolanthomas32 | Word VBA | 4 | 09-19-2017 06:25 AM |
How to get a Drop Down List Content Control box to fill in other areas | snips1982 | Word | 2 | 03-22-2017 03:37 AM |
Word 2010 Content Control help - Combo Boxes vs Drop Down List | proghy | Word | 1 | 09-16-2014 02:01 PM |