Microsoft Excel

Herbers Excel/VBA-Archiv

Excel sucht in Word

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

Könnte mir da jemand unter die Arme greifen?

Gruß
Stefan

  

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 Sub
Ich 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.

Langsam beginne ich zu verzweifeln...

Liebe Grüße
Stefan


  

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

Leider hab ich noch keine Rückmeldungen bekommen. Scheint ein scheiß Thema zu sein...

Ach ja

Liebe Grüße
Stefan


  

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

Gruß,


  

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

Gruß
Stefan


  

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

Gruß,


  

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

Gruß,


  

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 Sub
Viele Grüße

Martin


  

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 Sub
Viele Grüße

Martin


  

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 Sub
Viele Grüße

Martin


  

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 Sub
Viele Grüße

Martin