Edit:

Im Programmcode Zeile 21 müss stehen:   Application.Dialogs(wdDialogInsertPicture).Show 'öffne Dialog Grafik einfügen

Geändert:

Sub TEST_Grafik_TEST()
'
' Grafikeinfuegen Makro
Dim Verz As String
Dim Bild As InlineShape
Dim Breite As Single
Dim Hoehe As Single
Dim Altverz As String
Dim AbbText As String
Dim Antwort


'Do

 '   Antwort = MsgBox("ein (weiteres) Bild einfügen?", vbYesNo)
    'If Antwort = vbYes Then
        Verz = ActiveDocument.Path + "\Bilder\" 'Bildverzeichnis auswählen
        Altverz = Options.DefaultFilePath(Path:=wdPicturesPath) 'Defaultverzeichnis speichern
       ' Options.DefaultFilePath(Path:=wdPicturesPath) = Verz
        
       ' Dialog BildEinfuegen, Verz + "*.*" 'ALT öffne Dialog Grafik einfügen
       Application.Dialogs(wdDialogInsertPicture).Show 'öffne Dialog Grafik einfügen
        
        
        'Bildänderungen vornehemen: Bildbreite vereinheitlichen, Abbilungstext generieren
        For Each Bild In ActiveDocument.InlineShapes
            If Bild.AlternativeText <> "belegt" Then
                Breite = Bild.Width
                Bild.Select
                Hoehe = Bild.Height
                Bild.Width = 340.5
                Bild.Height = 340.5 / Breite * Hoehe
                Bild.AlternativeText = "belegt" 'neu eingefügtes Bild für If-Abfrage ausschließen
                Bild.Select
                Selection.InsertCaption Label:="Abb.", TitleAutoText:= _
                    "", Title:=": Pos. ", Position:=wdCaptionPositionBelow, _
                    ExcludeLabel:=0
              
                SendKeys "{Tab}" 'generieren einer neues Tabellenspalte
                
                    End If
        Next
        Options.DefaultFilePath(Path:=wdPicturesPath) = Altverz 'Defaultverzeichnis hinterlegen
      
    'End If
    
'Loop Until Antwort <> vbYes
   
End Sub