excelvbamacosms-wordexcel-2011

Get data from textbox in Word-UserForm


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.


Solution

  • 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 :)