,因爲我沒有找到一個方法來做到這一點直接嘗試時,我得到了一個解決辦法:
代碼在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
代碼在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
不知怎的,這作品。當我第一次在Word中嘗試「Dim xlWB As Excel.Workbook」時,我總會遇到運行時錯誤。當我在Excel中嘗試「Dim Doc As Word.Document」時,雖然我從來沒有得到一個錯誤......非常奇怪,但仍然設法讓它結束。
如果您對此有任何疑問,我將很樂意爲您提供幫助,如果有些事情我可以以更好的方式重寫,請不要猶豫,以發表評論。
感謝您的支持:)
使用跑好文章:http://www.rondebruin.nl/win/s9/win001.htm –
xlWB.Application.Run( 「SearchCompany(」 SomeCompany」 )「)應該是xlWB.Application。運行(「SearchCompany」,「SomeCompany」) –
Tim&Nathan:也不管用...... :(我馬上得到一個預期爲「=」的編譯錯誤(xlWB.Application.Run(「'」&xlWB& 「'!SearchFirma」,FSearchText)/ xlWB.Application.Run(「SearchFirma」,FSearchText))。在Mac上看起來真的不一樣了...... - .-其他想法? – Kathara