I have a Word document based on a template for invoices and a database in Excel containing two tables: Company and Person.
I want to put some string into the textbox in the userform in Word which will then be searched in Excel. Excel shall return the values to a MultiColumn-Listbox located in another UserForm (this userform will only show if there is more than 1 result for the searched string).
This is the code I have in Word to run the macro, which actually gets started:
CSearchText = UFCompanySearch.tbSearchCompany.Value 'Textbox -> Search-String
xlWB.Application.Run("SearchCompany")
This only works when SearchCompany is a sub or a function with no further specifications, so
Function SearchCompany(SearchText As String)
doesn't work as I cannot run the Macro as follows:
xlWB.Application.Run("SearchCompany("SomeCompany")") 'NOTE!
NOTE: This will NOT work!!
To fill the Listbox in the UserForm I think there is the possibility to fill it with an Excel table, so this should somehow work out.
THIS is the PROBLEM:
I cannot refer to the Search-TextBox in the Userform which is located in the word Document as neither "Doc!" nor "Doc." works. Like this I can't search the cells for the string. This is the code I have to find cells containing the string:
IF (InStr(xlComp.Cells(Row, 1), CSearchText) > 0) Or _
(InStr(xlComp.Cells(Row, 2), CSearchText) > 0) Or _
(InStr(xlComp.Cells(Row, 3), CSearchText) > 0) Then
This searches the Columns A-C for the entered string. (Code I found somewhere... I have been searching too much to know where from ^.^)
Is there a way to address the UserForm in Word or a workaround to get the "SearchText" from the userform to Excel?
I'm quite new in VBA, so the more detailed your answer the more probable I will understand it.
As I did not find a way to do it directly I got a workaround when trying:
Code in Word:
Private Sub cbFirmaSearch_Click()
ActiveDocument.FormFields("FSearchText").Result = UFFirmaSearch.txtFirmaSuchen.Value
xlWB.Application.Run "SearchFirma"
ActiveDocument.FormFields("FSearchText").Delete
Dim DFLastRow As Integer
DFLastRow = xlWB.Sheets("DataFirma").Cells(xlWB.Sheets("DataFirma").Rows.Count, "a").End(xlUp).Row
Dim lbFirmTar As ListBox
Set lbFirmTar = UFFirmaSearchList.lbFirmaSearchList
Dim Row As Integer
For Row = 2 To DFLastRow
With lbFirmTar
Dim ListIndex As Integer
ListIndex = UFFirmaSearchList.lbFirmaSearchList.ListCount
.AddItem xlWB.Sheets("DataFirma").Cells(Row, 1).Value, ListIndex
.List(ListIndex, 1) = xlWB.Sheets("DataFirma").Cells(Row, 2).Value
.List(ListIndex, 2) = xlWB.Sheets("DataFirma").Cells(Row, 3).Value
.List(ListIndex, 3) = xlWB.Sheets("DataFirma").Cells(Row, 4).Value
.List(ListIndex, 4) = xlWB.Sheets("DataFirma").Cells(Row, 5).Value
.List(ListIndex, 5) = xlWB.Sheets("DataFirma").Cells(Row, 6).Value
.List(ListIndex, 6) = xlWB.Sheets("DataFirma").Cells(Row, 7).Value
End With
Next Row
With UFFirmaSearchList
If (.lbFirmaSearchList.ListCount > 1) Then
UFFirmaSearch.Hide
.Show
ElseIf (.lbFirmaSearchList.ListCount = 1) Then
FirmaID = .lbFirmaSearchList.List(0, 0)
FirmaZusatz = .lbFirmaSearchList.List(0, 1)
FirmaName = .lbFirmaSearchList.List(0, 2)
FirmaAbteilung = .lbFirmaSearchList.List(0, 3)
FirmaAdresse = .lbFirmaSearchList.List(0, 4)
FirmaPLZ = .lbFirmaSearchList.List(0, 5)
FirmaOrt = .lbFirmaSearchList.List(0, 6)
UFFirmaSearch.lblfrFirmenangaben = "Firma ID : " & FirmaID & _
"Firmenzusatz : " & FirmaZusatz & _
"Name : " & FirmaName & _
"Firmenabteilung : " & FirmaAbteilung & _
"Adresse : " & FirmaAdresse & _
"PLZ / Ort : " & FirmaPLZ & " " & FirmaOrt
Else
MsgBox "No Entry found.", vbOKOnly
End If
End With
UFFirmaSearch.txtFirmaSuchen.SetFocus
End Sub
Code in Excel:
Sub SearchFirma()
Dim Doc As Word.Document
Set Doc = ActiveDocument
Dim xlFirm As Worksheet
Set xlFirm = ActiveWorkbook.Sheets("Firma")
Dim LastRow As Integer 'Last row on sheet "Firma" containing values
LastRow = xlFirm.Cells(xlFirm.Rows.Count, "a").End(xlUp).Row
Dim xlDatFirm As Worksheet
Set xlDatFirm = ActiveWorkbook.Sheets("DataFirma")
Dim FSearchText As String
FSearchText = Doc.FormFields("FSearchText").Result
For Row = 2 To LastRow
Dim DFNewRow As Integer 'Next free line on sheet "DataFirma"
DFNewRow = xlDatFirm.Cells(xlDatFirm.Rows.Count, "A").End(xlUp).Row + 1
If (InStr(1, xlFirm.Cells(Row, 1), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 2), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 3).Value, FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 4).Value, FSearchText, vbTextCompare) > 0) Then
xlDatFirm.Range("A" & DFNewRow).Value = xlFirm.Cells(Row, 1).Value
xlDatFirm.Range("B" & DFNewRow).Value = xlFirm.Cells(Row, 2).Value
xlDatFirm.Range("C" & DFNewRow).Value = xlFirm.Cells(Row, 3).Value
xlDatFirm.Range("D" & DFNewRow).Value = xlFirm.Cells(Row, 4).Value
xlDatFirm.Range("E" & DFNewRow).Value = xlFirm.Cells(Row, 5).Value
xlDatFirm.Range("F" & DFNewRow).Value = xlFirm.Cells(Row, 6).Value
xlDatFirm.Range("G" & DFNewRow).Value = xlFirm.Cells(Row, 7).Value
End If
Next Row
End Sub
Somehow this works. When I first tried "Dim xlWB As Excel.Workbook" in Word I would always get a runtime error. When I tried "Dim Doc As Word.Document" in Excel though I never got an error... very strange but still somehow managed to get it over with.
If you have any questions regarding this I will be happy to try to help and if there are things that I can rewrite in a better way, please don't hesitate to comment.
Thanks for the support :)