Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
660to664
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
660to664
660to664
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suche im Word-Dok

Suche im Word-Dok
05.09.2005 11:14:10
Matthias
Hallo Forum,
ich möchte über ein Excel-Makro ein Word-Dok nach einem Begriff durchsuchen und diesen + die zehn nachfolgenden Zeichen ausgeben.
Folgender Quelltext funktioniert, aber ich kann damit nur den Suchbegriff ausgeben.
Public

Sub cmdStart_Click()
Dim wdApp As Object
Dim ISO, EN As Double
Dim DIN As Variant
DIN = "din "
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\Antwort lieber.doc"
With wdApp.ActiveDocument.Content.Find
If .Execute(FindText:=DIN) = True Then
Worksheets(2).Cells(1, 1).Value = DIN
End If
End With
wdApp.ActiveDocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
End Sub

Bin für jede Hilfe dankbar.
Matthias

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suche im Word-Dok
05.09.2005 15:09:15
IngGi
Hallo Matthias,
so müsste es gehen:

Sub cmdStart_Click()
Dim wdApp As Object
Dim ISO, EN As Double
Dim DIN As Variant
Dim rng As Object
DIN = "din "
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\Antwort lieber.doc"
Set rng = wdApp.activedocument.content
If rng.Find.Execute(FindText:=DIN) = True Then
rng.End = rng.End + 10
Worksheets(2).Cells(1, 1).Value = rng
End If
wdApp.activedocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
End Sub
Gruß Ingolf
AW: Suche im Word-Dok
06.09.2005 08:39:07
Matthias
Hallo Ingolf,
vielen Dank für die Hilfe, funktioniert einwandfrei.
Hat mir sehr geholfen.
Schönen Tag noch.
Gruß Matthias
Anzeige
AW: Suche im Word-Dok
06.09.2005 08:39:21
Matthias
Hallo Ingolf,
vielen Dank für die Hilfe, funktioniert einwandfrei.
Hat mir sehr geholfen.
Schönen Tag noch.
Gruß Matthias
AW: noch ein Problem
06.09.2005 10:18:33
Matthias
Hi Ingolf,
ist es auch möglich nach auffinden des Suchbegriffs, noch weiter zu suchen, ob der Begriff nochmal in diesem Dokument auftaucht und falls er nochmal auftaucht, ihn wieder mit seinen 10 Nachfolgestellen auszugeben.
Hofffe Du kannst mir nochmal helfen.
Vielen Dank im Voraus.
Gruß Matthias
AW: noch ein Problem
06.09.2005 10:30:32
IngGi
Hallo Matthias,
das könnte dann so gehen:

Sub cmdStart_Click()
Dim wdApp As Object
Dim ISO, EN As Double
Dim DIN As Variant
Dim rng As Object
DIN = "din "
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\Antwort lieber.doc"
Set rng = wdApp.activedocument.content
Do While rng.Find.Execute(FindText:=DIN) = True
rng.End = rng.End + 10
Worksheets(2).Cells(1, 1).Value = rng
Loop
wdApp.activedocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
End Sub
Gruß Ingolf
Anzeige
AW: hat leider nicht funktioniert
06.09.2005 11:34:46
Matthias
Hi Ingolf,
ich bins nochmal. Dein Vorschlag funktioniert leider nicht und ich vermute das Problem ist, dass wenn der Suchbegriff gefunden ist das Word-Dok wieder von vorne "neu" durchsucht wird. Dadurch wird dann der Suchbegriff wieder gefunden, allerdings an genau der gleichen Stelle im Text wie zuvor und dadurch läuft die Schleife ewig weiter.
Ich hab jetzt folgendes versucht, was aber auch nicht funktioniert:
For i = 1 To 999
If Rng.Find.Execute(FindText:=DIN) = True Then
Rng.End = Rng.End + 10
Worksheets(2).Cells(i, 3).Value = Rng
ElseIf Rng.Find.Execute(FindText:=DIN) = False Then
Exit For
End If
Next i
Da hab ich diese Ausgabe erhalten
Zelle C1: DIN 1045 ..
Zelle C2: DIN 1045 ..
.
.
Zelle C999: DIN 1045 ..
Ich hab mir jetzt gedacht evtl. gehts mit folgendem:

Private Sub cmdErweitert_Click()
Dim wdApp, aWord As Object
Dim DIN, ISO As Variant
Dim Rng As Object
Dim i As Integer
DIN = "din"
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\daneben.doc"
Set Rng = wdApp.ActiveDocument.content
For Each aWord In Rng.Words
If aWord.Text = DIN Then
aWord.End = aWord.End + 10
End Sub

aber da bin ich noch nicht auf nen grünen Zweig gekommen.
Falls Dir noch was einfällt, bin für jeden Tip dankbar.
Vielen dank im Voraus
Gruß Matthias
Anzeige
AW: hat leider nicht funktioniert
06.09.2005 14:53:01
IngGi
Hallo Matthias,
ich denke, du hast mit deiner Vermutung recht. Word-VBA ist leider auch nicht so mein Ding. Aber folgendes könnte funktionieren.

Sub cmdStart_Click()
Dim wdApp As Object
Dim ISO, EN As Double
Dim DIN As Variant
Dim rng As Object
DIN = "din "
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\Antwort lieber.doc"
Set rng = wdApp.activedocument.content
Do While rng.Find.Execute(FindText:=DIN) = True
rng.End = rng.End + 10
Worksheets(2).Cells(1, 1).Value = rng
rng.Start = rng.End
rng.End = rng.Characters.Count
Loop
wdApp.activedocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
End Sub
Gruß Ingolf
Anzeige
AW: wunderbar, hat funktioniert
06.09.2005 16:45:19
Matthias
Hi Ingolf,
Dein Vorschlag war hervorragend. Jetzt funktionierts. Ich habs zwar noch weng ummodeln müssen, aber ohne Deinen Tip wär ich nicht drauf gekommen.
Ich habs jetzt so gemacht.

Sub cmdStart_Click()
Dim wdApp As Object
Dim ISO, EN As Double
Dim DIN As Variant
Dim rng As Object
DIN = "din "
Set wdApp = CreateObject(Class:="Word.Application")
wdApp.Documents.Open "L:\Arbeitsverzeichnis\Meneghini\Test\Antwort lieber.doc"
Set rng = wdApp.activedocument.content
For i = 1 To 999
If Rng.Find.Execute(FindText:=DIN) = True Then
Rng.End = Rng.End + 10
Worksheets(2).Cells(i, 3).Value = Rng
Rng.Start = Rng.End
ElseIf Rng.Find.Execute(FindText:=DIN) = False Then
Exit For
End If
Next i
wdApp.activedocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
End Sub

Also, noch mal vielen Dank.
Vieleicht hört man sich mal wieder.
Gruß Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige