Warum das überhaupt?

Weil Du öfter mal ein Bild mit Text im Word-Dokument hast.
Und der Text nicht anklickbar ist. Nicht kopierbar. Nicht suchbar.
Also: raus mit dem Text – automatisch.
Per VBA. Und OCR.

Zwei Wege:

• Lokal mit Tesseract
• Cloudbasiert mit Azure OCR

Welcher Weg für wen?

Schritt 1: Bilder im Word-Dokument finden und speichern

Sub ExtrahiereBilderAusDokument()
    Dim iShape As InlineShape
    Dim index As Long
    Dim pfad As String

    index = 1
    For Each iShape In ActiveDocument.InlineShapes
        If iShape.Type = wdInlineShapePicture Then
            pfad = Environ("TEMP") & "\ocr_img_" & index & ".png"
            iShape.Select
            Selection.CopyAsPicture

            ' In Zwischenablage als Bild speichern (z. B. mit StdPicture / DataObject) – oder als Workaround:
            ' Manuell Screenshot machen, wenn keine OLE-Exportmöglichkeit besteht

            ' Alternativ: gleich aus Datei einfügen, wenn Pfad bekannt
            index = index + 1
        End If
    Next iShape
End Sub

Für sauberen Workflow brauchst Du entweder:

• Originaldateien einfügen (z. B. per Pfad im Tag gespeichert)
• Oder Word-spezifisches Add-In, um Bilder sauber zu exportieren

Variante A: Tesseract OCR auf dem lokalen Bild

Function OCR_Tesseract(pfadBild As String) As String
    Dim cmd As String
    Dim pfadTXT As String
    Dim txt As String
    pfadTXT = Replace(pfadBild, ".png", "")

    cmd = "tesseract """ & pfadBild & """ """ & pfadTXT & """ -l deu"
    Shell cmd, vbHide

    Application.Wait Now + TimeValue("00:00:02")

    OCR_Tesseract = LadeTextdatei(pfadTXT & ".txt")
End Function

Function LadeTextdatei(pfad As String) As String
    Dim f As Integer, inhalt As String
    f = FreeFile
    Open pfad For Input As #f
    inhalt = Input$(LOF(f), f)
    Close f
    LadeTextdatei = inhalt
End Function

Variante B: Azure OCR nutzen

Function OCR_Azure(pfadBild As String) As String
    Dim http As Object
    Dim apiKey As String
    Dim endpoint As String
    Dim bytes() As Byte
    Dim json As String

    apiKey = "DEIN_AZURE_KEY"
    endpoint = "https://westeurope.api.cognitive.microsoft.com/vision/v3.2/read/analyze"

    bytes = LadeBytes(pfadBild)

    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    http.Open "POST", endpoint, False
    http.setRequestHeader "Ocp-Apim-Subscription-Key", apiKey
    http.setRequestHeader "Content-Type", "application/octet-stream"
    http.Send bytes

    If http.Status = 202 Then
        OCR_Azure = HoleOCRResult(http.getResponseHeader("Operation-Location"), apiKey)
    Else
        OCR_Azure = "Fehler: " & http.responseText
    End If
End Function

Function LadeBytes(pfad As String) As Byte()
    Dim bytes() As Byte
    Open pfad For Binary As #1
    ReDim bytes(LOF(1) - 1)
    Get #1, , bytes
    Close #1
    LadeBytes = bytes
End Function

Ergebnis abholen (Azure OCR ist asynchron)

Function HoleOCRResult(url As String, key As String) As String
    Dim http As Object
    Dim status As String
    Dim response As String

    Set http = CreateObject("MSXML2.ServerXMLHTTP")

    Do
        http.Open "GET", url, False
        http.setRequestHeader "Ocp-Apim-Subscription-Key", key
        http.Send
        response = http.responseText
        status = Mid(response, InStr(response, """status"":""") + 10, 10)

        If status Like "*succeeded*" Then Exit Do
        If status Like "*failed*" Then Exit Do

        Application.Wait Now + TimeValue("00:00:02")
    Loop

    HoleOCRResult = ExtrahiereTextAusJSON(response)
End Function

JSON-Auswertung

Function ExtrahiereTextAusJSON(json As String) As String
    Dim sc As Object
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"

    sc.AddCode "function parse(j){ var t=''; var l=JSON.parse(j).analyzeResult.readResults; for(var i=0;i<l.length;i++){ for(var j=0;j<l[i].lines.length;j++){ t += l[i].lines[j].text + '\n'; } } return t; }"
    ExtrahiereTextAusJSON = sc.Run("parse", json)
End Function

Schritt 3: Text ins Dokument einfügen

Sub FuegeOCRTextEin(ocrText As String)
    Selection.InsertAfter vbCrLf & ">>> Erkannt: " & vbCrLf & ocrText & vbCrLf
End Sub

Anwendung: Bilder → Text im Dokument

• Bild markieren
• Bild exportieren
• OCR starten
• Text an Cursor einfügen

Optional: Alles automatisieren für mehrseitige Dokumente.

Was Du beachten musst

• Tesseract braucht klaren Text, hohe Auflösung
• Azure ist besser bei Tabellen, strukturierter Darstellung
• Bei Bildern im Word-Dokument brauchst Du gute Exportlogik
• Sprache einstellen nicht vergessen: -l deu bei Tesseract

Was Du damit automatisieren kannst

„Das Bild kann bleiben – aber der Text gehört Dir.“

Wenn Du sowas in Word produktiv brauchst: Sag Bescheid.
Ich bau Dir das robust.
Ohne Add-In, ohne Umweg. Direkt im Word 2024.