ich hoffe ihr könnt mir bei folgender Aufgabe weiterhelfen. Ich habe nachfolgend einen VBA Code, mit dem man ein in einer Zelle in Excel eingetragenes Wort nach Doppelklick auf diese Zelle in einem PDF Dokument, deren Namen in der linken nebenstehenden Zelle eingetragen ist, suchen kann. Diese Suchfunktion funktioniert leider nur bei einem zu suchenden Wort und nicht wenn Umlaute ä, ö, ü in diesem Wort beinhaltet sind.
Hat jemand von Euch einen Lösungsvorschlag, wie ich im Code angeben kann, dass ebenfalls Satzteile (inklusive Leerstellen zwischen den Wörtern) inklusive Umlaute in den Wörtern im PDF Dokument gesucht werden können.
26.11.2019, 20:17 (Dieser Beitrag wurde zuletzt bearbeitet: 26.11.2019, 20:17 von sunny01.)
Hallo,
ich habe beiliegend eine Testumgebung mit einer Beispieldatei (zum Ausprobieren und Erweitern). Wichtig ist, dass die pdf Datei in einem Unterordner zum Speicherort der Excel Datei liegt.
zum Suchen bitte auf das Wort in Spalte B doppelklicken, dann wird das Wort in dem Dokument lt. Angabe in Spalte A gesucht.
es wäre wichtig für mich, wenn ich nach Satzteilen suchen könnte, z.B. im Text lt. voriger Anlage "Erläuterung zum Studienjahr". Dadurch könnte man eindeutige Textstellen im Dokument suchen lassen, da einzelne Wörter zumeist öfters im Text vorkommen.
Als Word-Makro kann man so die ganzen Paragraphen, die das Suchwort enthalten, ausgeben:
Code:
Sub T_5()
With ActiveDocument.Content.Find
.Text = "Wintersemester"
.Forward = True
While .Execute = True
i = i + 1: If i > 25 Then Stop
.Parent.Select
Set rng = Selection
rng.Expand wdParagraph
Debug.Print .Parent, rng
Wend
End With
End Sub
Den Suchtext aus Excel zu holen und das Ergebnis zurück nach Excel zu bringen, ist nicht so schwer.
ich habe aus meinem Blog einmal diesen Code und dann noch jenen Code genommen - und anschließend zusammengewürfelt: :21:
Code:
Option Explicit
' Wenn Word nicht offen ist wird diese Variable auf True
' gesetzt und Word am Ende wieder geschlossen
' War Word schon offen, beleibt es das auch
Dim blnTMP As Boolean
'--------------------------------------------------------------------------
' Module : Modul1
' Procedure : Main
' Author : Case (Ralf Stolzenburg)
' Date : 20.05.2019
' Purpose : Aus PDF-Dateien etwas auslesen - Dokumente danach umbenennen
' Note : Funktioniert erst ab Word 2013!!!!!!!!!!
'--------------------------------------------------------------------------
Public Sub Main()
' Dimensionieren der Variablen
Dim objDocument As Object
Const wdFindContinue = 1
Dim strDatei As String
Dim objRange As Object
Dim strTMP As String
Dim objFSO As Object
Dim objDir As Object
Dim strDir As String
Dim objApp As Object
Dim lngCalc As Long
Dim lngRef As Long
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
On Error GoTo Fin
' Die Excelapplikation wird ruhig gestellt
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
lngRef = Application.ReferenceStyle
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
' Der Objektvariablen objFSO das "FilesystemObject" zuweisen
'Set objFSO = CreateObject("Scripting.FileSystemObject")
' Wenn Du einen Ordnerauswahldialog möchtest
'Set objShell = CreateObject("Shell.Application")
'Set varDir = objShell.BrowseForFolder(0, "Ordner", &H4000, 17)
'If varDir Is Nothing Then Set objShell = Nothing: Exit Sub
'strDir = varDir.Self.Path
' Datei in einem Unterordner DIESER Exceldatei
strDir = ThisWorkbook.Path & "\Test\"
'strDir = "C:\Temp\Los\" ' Fester Pfad
strDir = IIf(Right(strDir, 1) <> "\", strDir & "\", strDir)
Set objApp = OffApp("Word")
' Word nicht sichtbar
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
strDatei = Dir$(strDir & "*.pdf", vbDirectory)
Do While strDatei <> ""
' Word- Pdf-Dokument öffnen - ab Word 2013!!!!!
Set objDocument = objApp.Documents.Open(strDir & strDatei)
With objApp.Selection.Find
.Forward = True
' Nach dem Text wird gesucht
.Text = "Eignungsprüfung"
While .Execute = True
'Set objRange = objApp.Selection.Bookmarks("\Line").Range
Set objRange = objApp.Selection.Bookmarks("\Para").Range
'Set objRange = objApp.Selection.Bookmarks("\Cell").Range
strTMP = strTMP & objRange.Text
Wend
objDocument.Close False
Set objRange = Nothing
Set objDocument = Nothing
End With
strDatei = Dir$()
Loop
Debug.Print strTMP
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
' Objektvariablen leeren
Set objFSO = Nothing
Set objDocument = Nothing
Set objApp = Nothing
' Die Applikation aufwecken
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = lngCalc
Application.ReferenceStyle = lngRef
.DisplayAlerts = True
.CutCopyMode = True
End With
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module : Modul1
' Procedure : OffApp
' Author : Case (Ralf Stolzenburg)
' Date : 20.05.2019
' Purpose : Start Applikation...
'--------------------------------------------------------------------------
Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function
Es gibt in Word auch Vordefinierte Textmarken. Mit denen kannst du bestimmen, wie viel du vom Suchtext sehen/ausgeben willst. :21:
zuerst einmal vielen Dank für Eure guten Vorschläge, ich werde diese noch ausprobieren.
Mir geht es im Prinzip gar nicht so sehr darum eine Textpassage automatisiert in ein anderes Programm zu übernehmen sondern darum, eine Textpassage im PDF Dokument durch Angabe der Textpassage in Excel automatisch im PDF Dokument suchen und markieren zu lassen. Habt ihr ev. eine Idee, wie mein jetziger Code ev. noch insofern angeglichen werden kann, dass er nicht nur ein Suchwort sondern mehrere aufeinanderfolgende Wörter (trotz der Leerzeichen dazwischen) erkennt?
- wenn die Mehr-Wort-Suche so wichtig ist, warum ist das Beispiel nur mit 1 Word
- warum zweifels Du, dass der Code nicht auch für mehrere Worte gehen sollte
Code:
Const sTx = "Bachelor of"
Sub T_5()
With ActiveDocument.Content.Find
.Text = sTx '"Wintersemester"
.Forward = True
While .Execute = True
'.Parent.Select
Set rng = Range(.Parent.Start, .Parent.End) 'Selection
rng.Expand wdParagraph
Debug.Print .Parent, rng
Wend
End With
End Sub
Die Variable "sTx" sollte aus Excel geholt werden. Dieser Code vermeidet "select", das bei der Ansteuerung von XL oft Probleme macht.
