![]() |
Betrifft: Excel sucht in Word
von: Stef26
Geschrieben am: 01.11.2014 11:15:45
Hallo liebe Forumsmitglieder,
leider bin ich kompletter VBA Anfänger und bräuchte eure Unterstützung.
Ich möchte in Excel die Spalte D durchlaufen in der Materialnummern stehen.
Ich möchte nun Zeile für Zeile die Werte in Spalte D einlesen und in einem Word Dok
suchen lassen.
Werden dies gefunden, so soll in der aktuellen gesuchten Zeile in Spalte B das Wort "im AP vorhanden" eingetragen werden.
Ich hab mich daran probiert (aus Netz gesucht), bin aber völlig überfordert damit:
Sub Wordsuchen() Dim wks As Worksheet Set wks = ActiveSheet Dim Zelle As Range Set objWordApp = CreateObject("Word.application") 'Starten der Word-Instanz und eine neues Dokument öffnen objWordApp.Visible = True 'Set objWordDok = objWordApp.documents.Add Set objWordDok = objWordApp.documents.Open("c:\test.doc") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row Set Zelle = Range("D" & i).Value With objWordApp.Selection .Find.Text = Zelle End Sub
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Stef26
Geschrieben am: 01.11.2014 22:55:14
Hallo nochmal,
ja ich probiere und probiere immer noch um mein Problem zu lösen.
Habe folgenden Code bisher:
Sub Wordsuchen() Dim wks As Worksheet Dim Tabname As Worksheet Dim Zelle As String 'Tabname = Sheets("Einstellungen").ComboBox1.Text Set objWordApp = CreateObject("Word.application") objWordApp.Visible = True Set objWordDok = objWordApp.documents.Open("C:\Temp\Test.docx") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row Zelle = Sheets("14416855").Range("D" & i).Value With objWordApp.Selection.Find .Text = Zelle If .Show = True Then Sheets("14416855").Range("B" & i).Value = "MAT im AP enthalten" End With i = i + 1 Next i End SubIch weis allerdings nicht wenn ich in Word ein Wort gefunden habe, wie ich dann die Info nach Excel bekomme. Mit if . Show geht's auf jeden Fall nicht.
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Stef26
Geschrieben am: 01.11.2014 23:29:02
Hallo nochmal,
ich hab nochmal etwas verändert, funktioniert aber leider immer noch nicht.
Sub Wordsuchen() Dim wks As Worksheet Dim Tabname As Worksheet Dim Zelle As String 'hier wollte ich die Tabelle aus einer Combo Box übernehmen funktionierte aber nicht 'Tabname = Sheets("Einstellungen").ComboBox1.Text Set objWordApp = CreateObject("Word.application") objWordApp.Visible = True Set objWordDok = objWordApp.documents.Open("C:\Temp\Test.docx") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row Zelle = Sheets("14416855").Range("D" & i).Value With objWordApp.Selection.Find .Text = Zelle If .Execute = True Then Sheets("14416855").Range("B" & i).Value = "MAT im AP enthalten" Else End If End With i = i + 1 Next i End Sub
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Mullit
Geschrieben am: 01.11.2014 23:48:28
Hallo,
das sollte auch über die Execute-Methode gehen:
If .Execute(FindText:=Zelle) Then
![]() ![]() |
Betrifft: AW: Schleife passt noch nicht ?
von: Stef26
Geschrieben am: 02.11.2014 08:11:10
Hallo Nochmal,
was hab ich bisher geschafft (da ich mich in VBA nicht auskenne ist das doch nicht schlecht)
Excel bekommt aus Spalte D von oben nach unten nach eine 8-stelligen Zahl
und sucht diese in Word. Gibt es diese Zahl, dann schreibt er in die selbe Zeile in Spalte B das er die Zahl gefunden hat.
Funktioniert aber nur für die erste Zeile.
Irgendwas passt an meiner Schleife noch nicht, da er mir es ab der Zweiten Zeile nicht mehr macht???
Wer kann mir dazu einen Tip geben?
Muss man evtl. in Word etwas zurücksetzen????
Hier mein code (Danke an Mullit mit If .Execute(FindText:=Zelle) Then hat es funktioniert)
Sub Wordsuchen() Dim wks As Worksheet Dim Tabname As Worksheet Dim Zelle As String 'hier wollte ich die Tabelle aus einer Combo Box übernehmen funktionierte aber nicht 'Tabname = Sheets("Einstellungen").ComboBox1.Text Set objWordApp = CreateObject("Word.application") objWordApp.Visible = True Set objWordDok = objWordApp.documents.Open("C:\Temp\Test.docx") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row Zelle = Sheets("14416855").Range("D" & i).Value With objWordApp.Selection.Find .Text = Zelle If .Execute(FindText:=Zelle) Then Sheets("14416855").Range("B" & i).Value = "MAT im AP _ enthalten" End With i = i + 1 Next i End Sub
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Mullit
Geschrieben am: 01.11.2014 23:31:15
Hallo,
so könnt's gehen:
If .Found = True Then
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Mullit
Geschrieben am: 01.11.2014 23:35:59
Hallo,
da sollte dann auch das reichen:
If .Found Then
![]() ![]() |
Betrifft: AW: Excel sucht in Word
von: Martin S.
Geschrieben am: 02.11.2014 10:05:16
Hallo Stefan,
probiere es mal so:
Sub Wordsuchen() Dim i As Integer Dim objWordDok As Object, objWordApp As Object Set objWordApp = CreateObject("Word.application") 'Starten der Word-Instanz und eine neues Dokument öffnen objWordApp.Visible = True 'Set objWordDok = objWordApp.documents.Add Set objWordDok = objWordApp.documents.Open("c:\test.doc") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row With objWordApp.Selection With .Find .Execute Range("D" & i).Text If .Found Then Cells(i, 2) = "im AP vorhanden" End With .Collapse End With Next i objWordApp.Quit End SubViele Grüße
![]() ![]() |
Betrifft: kleine Optimierung
von: Martin S.
Geschrieben am: 02.11.2014 10:38:38
Hallo Stefan,
in Excel predige ich immer ohne "Select" zu arbeiten, dann will ich das auch in Word so handhaben. Hier der Code noch einmal ohne Select:
Sub Wordsuchen() Dim i As Integer Dim objWordDok As Object, objWordApp As Object Set objWordApp = CreateObject("Word.application") 'Starten der Word-Instanz und eine neues Dokument öffnen objWordApp.Visible = True 'Set objWordDok = objWordApp.documents.Add Set objWordDok = objWordApp.documents.Open("c:\test.doc") For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row With objWordApp.ActiveDocument.Content With .Find .Execute Range("D" & i).Text If .Found Then Cells(i, 2) = "im AP vorhanden" End With End With Next i 'Word-Dokument schließen objWordDok.Close 'Word-Anwendung beenden 'objWordApp.Quit End SubViele Grüße
![]() ![]() |
Betrifft: AW: kleine Optimierung
von: Stef26
Geschrieben am: 02.11.2014 13:25:48
Hallo Martin,
besten Dank das ist es !!!!
Vielen Dank
:-)
Stefan
![]() ![]() |
Betrifft: AW: kleine Optimierung
von: Martin S.
Geschrieben am: 03.11.2014 15:21:59
Hallo Stefan,
ich habe mich jetzt doch noch einmal kurz mit Word-VBA beschäftigt, da ich mit dem ständigen "Neustart" der Find-Methode noch nicht ganz zufrieden war. Im Internet fand ich den Value-Wert der für Excel unbekannten "Wrap"-Enum-Konstante "wdFindContinue":
http://msdn.microsoft.com/en-us/library/office/ff821516(v=office.15).aspx
Dein Code hatte damals nur bei der ersten Zeile geklappt, weil "Wrap" standardmäßig auf "wdFindStop" (Value=0) festgelegt ist.
Hier noch einmal eine Optimierung des Codes:
Sub Wordsuchen() Dim i As Integer Dim objWordDok As Object, objWordApp As Object Set objWordApp = CreateObject("Word.application") 'Starten der Word-Instanz und eine neues Dokument öffnen objWordApp.Visible = True Set objWordDok = objWordApp.documents.Open("c:\test.doc") With objWordApp.ActiveDocument.Content.Find For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row .Execute Trim(Cells(i, 4).Text), Wrap:=1 If .Found Then Cells(i, 2) = "im AP vorhanden" Next i End With 'Word-Dokument schließen objWordDok.Close Set objWordDok = Nothing 'Word-Anwendung beenden 'objWordApp.Quit Set objWordApp = Nothing End SubViele Grüße
![]() ![]() |
Betrifft: ...wenn du es auf die Spitze treiben möchtest...
von: Martin S.
Geschrieben am: 03.11.2014 15:38:52
Hallo Stefan,
naja, wir Excel-Freaks finden einfach kein Ende. Hier mal noch eine Variante zur Code-Einsparung und ohne Objekt-Variablen:
Sub Wordsuchen() Dim i As Integer With CreateObject("Word.application") 'Starten der Word-Instanz und eine neues Dokument öffnen .Visible = True With .documents.Open("c:\test.doc") With .Content.Find For i = 1 To Cells(Rows.Count, 4).End(xlUp).Row .Execute Trim(Cells(i, 4).Text), Wrap:=1 If .Found Then Cells(i, 2) = "im AP vorhanden" Next i End With 'Word-Dokument schließen .Close End With 'Word-Anwendung beenden '.Quit End With End SubViele Grüße
![]() |