#1
|
|||
|
|||
Multiple entries from ListBox
Hello,
I have created a word template with User Form. In the latter; I have one field (actually a ListBox) where people can choose several entries. The coding of this box is: ListBoxMarking.List = Array("", "NATO", "The United Nations", "the African Union", "Troop Contributing States") The idea is that people can choose any entry, be it one, two or more. These entries would then appear in the created Word document. If no option was chosen, nothing should appear. If any option is chosen, it ought to be preceded by the phrase "Releasable to ". The coding for that is: Private Function Marking() As String Dim x As Integer Marking = "" For x = 0 To Me.ListBoxMarking.ListCount - 1 If Me.ListBoxMarking.Selected(x) Then If Marking = "" Then Marking = Me.ListBoxMarking.List(x) Else: Marking = "Releasable to " & Marking & ", " & Me.ListBoxMarking.List(x) End If End If Next x End Function The trouble is that the phrase "Releasable to " only appears when there is multiple choices and stays out when only on option is chosen. Could you please advise to fix this? Thanks, Paskie_be |
#2
|
|||
|
|||
Code:
Private Function Marking() As String Dim lngIndex As Long Dim arrMarking() As String For lngIndex = 0 To ListBoxMarking.ListCount - 1 If ListBoxMarking.Selected(lngIndex) Then Marking = Marking & ListBoxMarking.List(lngIndex) & "|" End If Next lngIndex If Marking <> vbNullString Then arrMarking = Split(Left(Marking, Len(Marking) - 1), "|") Marking = vbNullString Select Case UBound(arrMarking) Case 0: Marking = arrMarking(0) Case 1: Marking = arrMarking(0) & " and " & arrMarking(1) Case Else For lngIndex = 0 To UBound(arrMarking) If Not lngIndex = UBound(arrMarking) Then Marking = Marking & arrMarking(lngIndex) & ", " Else Marking = Marking & " and " & arrMarking(lngIndex) End If Next lngIndex End Select Marking = "Releasable to " & Marking End If lbl_Exit: Exit Function End Function |
#3
|
|||
|
|||
On second thought, as functions are intended to be lasting and perform a "repeatable" process, it might be best to have general function that returns a comma/and delimited list from multiple listbox entries:
Code:
Private Sub CommandButton1_Click() MsgBox "Releaseable to " & fcnComma_And_DelimitedList(ListBoxMarking) End Sub Private Sub UserForm_Initialize() ListBoxMarking.List = Split("NATO,The United Nations,the African Union,Troop Contributing States", ",") End Sub Private Function fcnComma_And_DelimitedList(oList As Object) As String Dim strTmp As String Dim lngIndex As Long Dim arrListMembers() As String For lngIndex = 0 To oList.ListCount - 1 If oList.Selected(lngIndex) Then strTmp = strTmp & oList.List(lngIndex) & "|" End If Next lngIndex If strTmp <> vbNullString Then arrListMembers = Split(Left(strTmp, Len(strTmp) - 1), "|") strTmp = vbNullString Select Case UBound(arrListMembers) Case 0: strTmp = arrListMembers(0) Case 1: strTmp = arrListMembers(0) & " and " & arrListMembers(1) Case Else For lngIndex = 0 To UBound(arrListMembers) If Not lngIndex = UBound(arrListMembers) Then strTmp = strTmp & arrListMembers(lngIndex) & ", " Else strTmp = strTmp & " and " & arrListMembers(lngIndex) End If Next lngIndex End Select fcnComma_And_DelimitedList = strTmp End If lbl_Exit: Exit Function End Function |
#4
|
|||
|
|||
Multiple entries from ListBox
This is the interface created (I know, the colour!)
And this is the overall coding for the page: Private Sub CommandButtonCreateCoverPage_Click() InsertExistingBuildingBlock Me.Repaint EUMSCoverPageData.hide End Sub Private Sub ListBoxMarking_Click() End Sub Private Sub Userform_initialize() ComboBoxCoverPageOriginator.List = Array("EUMS", "MPCC") ComboBoxDocumentType.List = Array("WORKING DOCUMENT", "ADMINISTRATIVE DOCUMENT") ComboBoxEEASNrYYYY.List = Array("2017", "2018", "2019", "2020", "2021", "2022", "2023", "2024", "2025") 'ComboBoxClass.List = Array("RESTREINT UE/EU RESTRICTED", "CONFIDENTIEL UE/EU CONFIDENTIAL", "SECRET UE/EU SECRET") ListBoxMarking.List = Array("", "NATO", "The United Nations", "the African Union", "Troop Contributing States") ListBoxToAcronym.List = Array("PSDC/CSDP", "EUMC", "PSC", "CY+EDA", "NCI") ComboBoxDir.List = Array("", "Director General", "Deputy Director General", "External Relations", "Synchronisation", "Horizontal Coordination", "CONCAP Directorate", "Intelligence Directorate", "Operations Directorate", "Logistics Directorate", "CIS Directorate", "MPCC") ComboBoxPrevDocYYYY.List = Array("2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018", "2019") ComboBoxPhrase.List = Array("", "Silence Procedure", "Comments", "Compilation of Comments", "Outcome", "EUMC Presentation") End Sub Private Function Marking() As String Dim x As Integer Marking = "" For x = 0 To Me.ListBoxMarking.ListCount - 1 If Me.ListBoxMarking.Selected(x) Then If Marking = "" Then Marking = Me.ListBoxMarking.List(x) Else: Marking = "Releasable to " & Marking & ", " & Me.ListBoxMarking.List(x) End If End If Next x End Function Private Sub ComboBoxPhrase_Change() If ComboBoxPhrase.Value = "" Then TextBoxSetPhrase.Value = "" End If If ComboBoxPhrase.Value = "Silence Procedure" Then TextBoxSetPhrase.Value = "Delegations will find attached the " & TextBoxDocTitle.Value & ". The document is released under silence procedure expiring at " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Comments" Then TextBoxSetPhrase.Value = "Delegations will find attached the " & TextBoxDocTitle & ". Member States' written comments are requested by " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Compilation of Comments" Then TextBoxSetPhrase.Value = "Delegations will find attached the compilation of comments on the document in Reference, for discussion in the EUMCWG at " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Outcome" Then TextBoxSetPhrase.Value = "Delegations will find attached the outcomes from the " & TextBoxDocTitle & " " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "EUMC Presentation" Then TextBoxSetPhrase.Value = "This document consists of XXX pages, including this cover page." End If End Sub Private Function Acronym() As String Dim x As Integer Acronym = "" For x = 0 To Me.ListBoxToAcronym.ListCount - 1 If Me.ListBoxToAcronym.Selected(x) Then If Acronym = "" Then Acronym = Me.ListBoxToAcronym.List(x) Else: Acronym = Acronym & "," & Me.ListBoxToAcronym.List(x) End If End If Next x End Function Sub InsertExistingBuildingBlock() Select Case ComboBoxCoverPageOriginator.ListIndex Case Is = 0 AutoTextToBM ("VCPBookMark01"), ActiveDocument.AttachedTemplate, "EUMSHeader" AutoTextToBM ("VCPBookMark02"), ActiveDocument.AttachedTemplate, "DocType" AutoTextToBM ("VCPBookMark03"), ActiveDocument.AttachedTemplate, "DocReferences" AutoTextToBM ("VCPBookMark04"), ActiveDocument.AttachedTemplate, "AuthorDetails" AutoTextToBM ("VCPBookMark05"), ActiveDocument.AttachedTemplate, "Page2Title" Case Else AutoTextToBM ("VCPBookMark01"), ActiveDocument.AttachedTemplate, "MPCCHeader" AutoTextToBM ("VCPBookMark02"), ActiveDocument.AttachedTemplate, "DocType" AutoTextToBM ("VCPBookMark03"), ActiveDocument.AttachedTemplate, "DocReferences" AutoTextToBM ("VCPBookMark04"), ActiveDocument.AttachedTemplate, "AuthorDetails" AutoTextToBM ("VCPBookMark05"), ActiveDocument.AttachedTemplate, "Page2Title" End Select With ActiveDocument .Bookmarks("VCPDocYrHdr").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPDocNrHdr").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPClassHdr").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPMarkingHdr").Range.Text = Marking .Bookmarks("VCPDocYrFtr").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPDocNrFtr").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPDirectorateFtr").Range.Text = ComboBoxDir.Value .Bookmarks("VCPClassFtr").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPMarkingFtr").Range.Text = Marking .Bookmarks("VCPBookMark02a").Range.Text = ComboBoxDocumentType.Value .Bookmarks("VCPBookMark02b").Range.Text = DTDocDate.Value .Bookmarks("VCPBookMark03a").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPBookMark03b").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPBookMark03c").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPBookMark03d").Range.Text = Marking .Bookmarks("VCPBookMark03e").Range.Text = Acronym .Bookmarks("VCPBookMark03f").Range.Text = TextBoxDocTitle.Value .Bookmarks("VCPBookMark03g").Range.Text = ComboBoxPrevDocYYYY.Value .Bookmarks("VCPBookMark03h").Range.Text = TextBoxPrevDocNr.Value '.Bookmarks("VCPBookMark04a").Range.Text = ComboBoxDir.Value .Bookmarks("VCPBookMark04b").Range.Text = TextBoxActionOfficer.Value .Bookmarks("VCPBookMark04c").Range.Text = TextBoxSetPhrase.Value .Bookmarks("VCPBookMark05a").Range.Text = TextBoxDocTitle.Value End With Dim LblEEASNrNNNN As Range Set LblEEASNrNNNN = ActiveDocument.Bookmarks("VCPBookMark03b").Range LblEEASNrNNNN.Text = Me.TextBoxEEASNrNNNN.Value Dim LblDocTitle As Range Set LblDocTitle = ActiveDocument.Bookmarks("VCPBookMark03f").Range LblDocTitle.Text = Me.TextBoxDocTitle.Value Dim LblPrevDocNr As Range Set LblPrevDocNr = ActiveDocument.Bookmarks("VCPBookMark03h").Range LblPrevDocNr.Text = Me.TextBoxPrevDocNr.Value Dim LblActionOfficer As Range Set LblActionOfficer = ActiveDocument.Bookmarks("VCPBookMark04b").Range LblActionOfficer.Text = Me.TextBoxActionOfficer.Value Dim LblSetPhrase As Range Set LblSetPhrase = ActiveDocument.Bookmarks("VCPBookMark04c").Range LblSetPhrase.Text = Me.TextBoxSetPhrase.Value End Sub Public Sub AutoTextToBM(strbmName As String, oTemplate As Template, strAutotext As String) Dim orng As Range On Error GoTo lbl_exit With ActiveDocument Set orng = .Bookmarks(strbmName).Range Set orng = oTemplate.AutoTextEntries(strAutotext).Insert(Wher e:=orng, RichText:=True) .Bookmarks.Add Name:=strbmName, Range:=orng End With lbl_exit: Exit Sub End Sub Would your solution fit in here? Thanks a milllion. Päscal DANIELS |
#5
|
|||
|
|||
.Bookmarks("VCPMarkingHdr").Range.Text = "Releasable to " & fcnComma_And_DelimitedList(ListBoxMarking)
|
#6
|
|||
|
|||
This is now the code, which works, except for one thing, as I get a message Run-time error '5941' on the line in red:
Private Sub CommandButtonCreateCoverPage_Click() InsertExistingBuildingBlock Me.Repaint EUMSCoverPageData.hide End Sub Private Sub Userform_initialize() ComboBoxCoverPageOriginator.List = Array("EUMS", "MPCC") ComboBoxDocumentType.List = Array("WORKING DOCUMENT", "ADMINISTRATIVE DOCUMENT") ComboBoxEEASNrYYYY.List = Array("2020", "2021", "2022", "2023", "2024", "2025") 'ComboBoxClass.List = Array("RESTREINT UE/EU RESTRICTED", "CONFIDENTIEL UE/EU CONFIDENTIAL", "SECRET UE/EU SECRET") ListBoxMarking.List = Array("", "NATO", "The United Nations", "the African Union", "Troop Contributing States") ListBoxToAcronym.List = Array("PSDC/CSDP", "EUMC", "PSC", "CY+EDA", "NCI") ComboBoxDir.List = Array("", "Director General", "Deputy Director General", "External Relations", "Synchronisation", "Horizontal Coordination", "CONCAP Directorate", "Intelligence Directorate", "Operations Directorate", "Logistics Directorate", "CIS Directorate", "MPCC") ComboBoxPrevDocYYYY.List = Array("2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018", "2019", "2020") ComboBoxPhrase.List = Array("", "Silence Procedure", "Comments", "Compilation of Comments", "Outcome", "EUMC Presentation") End Sub Private Function Marking() As String Dim lngIndex As Long Dim arrMarking() As String For lngIndex = 0 To ListBoxMarking.ListCount - 1 If ListBoxMarking.Selected(lngIndex) Then Marking = Marking & ListBoxMarking.List(lngIndex) & "|" End If Next lngIndex If Marking <> vbNullString Then arrMarking = Split(Left(Marking, Len(Marking) - 1), "|") Marking = vbNullString Select Case UBound(arrMarking) Case 0: Marking = arrMarking(0) Case 1: Marking = arrMarking(0) & " and " & arrMarking(1) Case Else For lngIndex = 0 To UBound(arrMarking) If Not lngIndex = UBound(arrMarking) Then Marking = Marking & arrMarking(lngIndex) & ", " Else Marking = Marking & " and " & arrMarking(lngIndex) End If Next lngIndex End Select Marking = "Releasable to " & Marking End If lbl_Exit: Exit Function End Function Private Sub ComboBoxPhrase_Change() If ComboBoxPhrase.Value = "" Then TextBoxSetPhrase.Value = "" End If If ComboBoxPhrase.Value = "Silence Procedure" Then TextBoxSetPhrase.Value = "Delegations will find attached the " & TextBoxDocTitle.Value & ". The document is released under silence procedure expiring at " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Comments" Then TextBoxSetPhrase.Value = "Delegations will find attached the " & TextBoxDocTitle & ". Member States' written comments are requested by " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Compilation of Comments" Then TextBoxSetPhrase.Value = "Delegations will find attached the compilation of comments on the document in Reference, for discussion in the EUMCWG at " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "Outcome" Then TextBoxSetPhrase.Value = "Delegations will find attached the outcomes from the " & TextBoxDocTitle & " " & DTDLHour & " on " & DTDLDate & "." End If If ComboBoxPhrase.Value = "EUMC Presentation" Then TextBoxSetPhrase.Value = "This document consists of XXX pages, including this cover page." End If End Sub Private Function Acronym() As String Dim x As Integer Acronym = "" For x = 0 To Me.ListBoxToAcronym.ListCount - 1 If Me.ListBoxToAcronym.Selected(x) Then If Acronym = "" Then Acronym = Me.ListBoxToAcronym.List(x) Else: Acronym = Acronym & "," & Me.ListBoxToAcronym.List(x) End If End If Next x End Function Sub InsertExistingBuildingBlock() Select Case ComboBoxCoverPageOriginator.ListIndex Case Is = 0 AutoTextToBM ("VCPBookMark01"), ActiveDocument.AttachedTemplate, "EUMSHeader" AutoTextToBM ("VCPBookMark02"), ActiveDocument.AttachedTemplate, "DocType" AutoTextToBM ("VCPBookMark03"), ActiveDocument.AttachedTemplate, "DocReferences" AutoTextToBM ("VCPBookMark04"), ActiveDocument.AttachedTemplate, "AuthorDetails" AutoTextToBM ("VCPBookMark05"), ActiveDocument.AttachedTemplate, "Page2Title" Case Else AutoTextToBM ("VCPBookMark01"), ActiveDocument.AttachedTemplate, "MPCCHeader" AutoTextToBM ("VCPBookMark02"), ActiveDocument.AttachedTemplate, "DocType" AutoTextToBM ("VCPBookMark03"), ActiveDocument.AttachedTemplate, "DocReferences" AutoTextToBM ("VCPBookMark04"), ActiveDocument.AttachedTemplate, "AuthorDetails" AutoTextToBM ("VCPBookMark05"), ActiveDocument.AttachedTemplate, "Page2Title" End Select With ActiveDocument .Bookmarks("VCPDocYrHdr").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPDocNrHdr").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPClassHdr").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPMarkingHdr").Range.Text = Marking .Bookmarks("VCPDocYrFtr").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPDocNrFtr").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPDirectorateFtr").Range.Text = ComboBoxDir.Value .Bookmarks("VCPClassFtr").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPMarkingFtr").Range.Text = Marking .Bookmarks("VCPBookMark02a").Range.Text = ComboBoxDocumentType.Value .Bookmarks("VCPBookMark02b").Range.Text = DTDocDate.Value .Bookmarks("VCPBookMark03a").Range.Text = ComboBoxEEASNrYYYY.Value .Bookmarks("VCPBookMark03b").Range.Text = TextBoxEEASNrNNNN.Value .Bookmarks("VCPBookMark03c").Range.Text = "RESTREINT UE / EU RESTRICTED" .Bookmarks("VCPBookMark03d").Range.Text = Marking .Bookmarks("VCPBookMark03e").Range.Text = Acronym .Bookmarks("VCPBookMark03f").Range.Text = TextBoxDocTitle.Value .Bookmarks("VCPBookMark03g").Range.Text = ComboBoxPrevDocYYYY.Value .Bookmarks("VCPBookMark03h").Range.Text = TextBoxPrevDocNr.Value .Bookmarks("VCPBookMark04a").Range.Text = ComboBoxDir.Value .Bookmarks("VCPBookMark04b").Range.Text = TextBoxActionOfficer.Value .Bookmarks("VCPBookMark04c").Range.Text = TextBoxSetPhrase.Value .Bookmarks("VCPBookMark05a").Range.Text = TextBoxDocTitle.Value End With Dim LblEEASNrNNNN As Range Set LblEEASNrNNNN = ActiveDocument.Bookmarks("VCPBookMark03b").Range LblEEASNrNNNN.Text = Me.TextBoxEEASNrNNNN.Value Dim LblDocTitle As Range Set LblDocTitle = ActiveDocument.Bookmarks("VCPBookMark03f").Range LblDocTitle.Text = Me.TextBoxDocTitle.Value Dim LblPrevDocNr As Range Set LblPrevDocNr = ActiveDocument.Bookmarks("VCPBookMark03h").Range LblPrevDocNr.Text = Me.TextBoxPrevDocNr.Value Dim LblActionOfficer As Range Set LblActionOfficer = ActiveDocument.Bookmarks("VCPBookMark04b").Range LblActionOfficer.Text = Me.TextBoxActionOfficer.Value Dim LblSetPhrase As Range Set LblSetPhrase = ActiveDocument.Bookmarks("VCPBookMark04c").Range LblSetPhrase.Text = Me.TextBoxSetPhrase.Value End Sub Public Sub AutoTextToBM(strbmName As String, oTemplate As Template, strAutotext As String) Dim orng As Range On Error GoTo lbl_Exit With ActiveDocument Set orng = .Bookmarks(strbmName).Range Set orng = oTemplate.AutoTextEntries(strAutotext).Insert(Wher e:=orng, RichText:=True) .Bookmarks.Add Name:=strbmName, Range:=orng End With lbl_Exit: Exit Sub End Sub |
#7
|
|||
|
|||
In the document you posted in your last message, there is no bookmark named:
VCPBookMark03b |
#8
|
|||
|
|||
OK. Well spotted. I'll see to it. Thanks a million.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
ListBox with multiple columns | Kaatje | Word VBA | 2 | 02-27-2016 09:37 AM |
Link listbox (with multiple columns) to bookmark based on selection | dsjk9190 | Word VBA | 5 | 01-29-2015 11:28 PM |
This is a Userform LIstbox queston: A variable does not set to the value of a listbox | CatMan | Excel Programming | 14 | 08-18-2014 08:14 PM |
This is a Userform LIstbox queston: A variable does not set to the value of a listbox | CatMan | Excel | 1 | 08-08-2014 09:41 AM |
Delete Multiple Entries | dudeabides | Office | 1 | 07-04-2011 02:49 AM |