Kann man über Excel-VBA über eine Routine Bilder öffnen und diese in Word einfügen?

1 Antwort

Ja, es ist möglich. Die Aufgabe gilt es aber zu zerlegen.

Bild vom pC auswählen. Datei Wahl Dialog.

Word datei öffnen. Datei Wahl dialog

Paragraphen in der word Datei auswählen. Oder neuen Paeagraphen anlegen.

Bild in den Paragraphen einfügen.

Positionieren und ggf Größe anpassen.

Word speichern und schließen.

Code zu jedem Anteil kann im Netz gefunden werden.

fx8350 
Fragesteller
 20.06.2022, 10:01

Hi,

ich habe es bereits gelöst, zumindest funktioniert es so:

Public Sub AddPics()
    Dim fd As Office.FileDialog, sfiles As Variant, rng As Object, shp As InlineShape, iWidth As Single, pFormat As Object
        
...
    File = Dir(Path & aName)
    
    Set Wdoc = GetObject(Path & File)
    Set wrd = Wdoc.Application
    
    'Dateidialog öffnen
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
    .Title = "Bilder auswählen"
    .AllowMultiSelect = True
    .ButtonName = "Auswählen"
    .Filters.Clear
    .Filters.Add "Bilder", "*.gif; *.png; *.jpg; *.jpeg", 1
    .FilterIndex = 1
    .InitialFileName = "C:\Users\Public\Pictures"
    .Show
    End With
    
    With wrd
    Select Case File
    Case Is = ""
    msg = MsgBox("Fehler!", vbOKOnly + vbExclamation, "Warnhinweis!")
    Exit Sub

    Case Else
    .Documents.Open (Path & File)
    .Activate
    .Visible = True
    
    If fd.SelectedItems.Count > 0 Then

    With Wdoc
        
    'Textmarke "seitenende" in Fehlermeldung als Range festlegen und auswählen
    Set rng = .Bookmarks("seitenende").Range
    .Bookmarks("seitenende").Range.Select
    
    For Each sfiles In fd.SelectedItems
    
    'Ausgewählte Bilder einfügen
    rng.InlineShapes.AddPicture FileName:=sfiles
    
    Next sfiles
    
    'Bilder skalieren
    For Each shp In Wdoc.InlineShapes
    If shp.LockAspectRatio = msoFalse Then
    shp.LockAspectRatio = msoTrue
    End If
        
    shp.Width = CentimetersToPoints(15)
    iWidth = shp.ScaleWidth
    shp.ScaleHeight = iWidth

    Next shp
    
    'Textmarke neu setzen
    .Bookmarks.Add "seitenende", rng
    
    With shp.Wdoc
    
    'Word Dokument speichern
    .SaveAs "XXXX" & Year(Now) & "\" & aName
    .Close
        
    End With

    End If

    'aufräumen
    wrd.Quit
    Set wrd = Nothing
    Set Wdoc = Nothing
   
    End Select
    End With

    'End If
    
End Sub

Ich schaffe es nun einfach nicht mehr einen Zeilenabstand Zwischen den Bildern hinzu bekommen (.ParagraphFormat.LineSpacingRule = wdLineSpaceDouble) und dass die Bilder zentriert sind.

Zwar habe ich bereits einige Lösungsansätze gefunden, aber ich erhalte immer Fehlermeldungen. Ich bekomme es einfach nicht hin.

0
fx8350 
Fragesteller
 20.06.2022, 11:01
@fx8350

Ok, ich habe es nun auch hinbekommen. Der Code sieht nun so aus, wobei ich bestimmt Fehler gemacht habe, aber es scheint zu funktionieren:

Public Sub AddPics()
    Dim fd As Office.FileDialog, sfiles As Variant, rng As Object, shp As InlineShape, iWidth As Single, pFormat As Object
        
...


    File = Dir(Path & aName)
    
    'Fehlermeldung öffnen
    Set Wdoc = GetObject(Path & File)
    Set wrd = Wdoc.Application
    
    'Dateidialog öffnen
    Set fd = Application.FileDialog(msoFileDialogFilePicker)


    With fd
    .Title = "Bilder auswählen"
    .AllowMultiSelect = True
    .ButtonName = "Auswählen"
    .Filters.Clear
    .Filters.Add "Bilder", "*.gif; *.png; *.jpg; *.jpeg", 1
    .FilterIndex = 1
    .InitialFileName = "C:\Users\Public\Pictures"
    .Show
    End With
    
    With wrd
    Select Case File
    Case Is = ""
    msg = MsgBox("Fehler!", vbOKOnly + vbExclamation, "Warnhinweis!")
    Exit Sub

    Case Else
    .Documents.Open (Path & File)
    .Activate
    .Visible = True
    
    If fd.SelectedItems.Count > 0 Then

    With Wdoc
        
    Set rng = .Bookmarks("seitenende").Range
    .Bookmarks("seitenende").Range.Select
    
    .Bookmarks("seitenende").Range.Paragraphs.LineSpacingRule = wdLineSpaceDouble
    
    For Each sfiles In fd.SelectedItems
    
    'Ausgewählte Bilder einfügen
    rng.InlineShapes.AddPicture FileName:=sfiles
    
    Next sfiles
    
    'Bilder skalieren
    For Each shp In Wdoc.InlineShapes
    If shp.LockAspectRatio = msoFalse Then
    shp.LockAspectRatio = msoTrue
    End If
        
    shp.Width = CentimetersToPoints(15)
    iWidth = shp.ScaleWidth
    shp.ScaleHeight = iWidth

    Next shp
    
    'Textmarke neu setzen
    .Bookmarks.Add "seitenende", rng
    
    'Word Dokument speichern
    .SaveAs "Q:\QS_Baecker\Interne Fehlererfassung\" & Year(Now) & "\" & aName
    .Close
        
    End With

    End If

    'aufräumen
    wrd.Quit
    Set wrd = Nothing
    Set Wdoc = Nothing
   
    End Select
    End With

    'End If
    
End Sub
0
fx8350 
Fragesteller
 20.06.2022, 11:14
@fx8350

Das klappt nun leider doch nicht richtig, da jedes zweite Mal, wenn Bilder nachträglich eingefügt werden, hängt es hier:

 ...
   shp.Width = CentimetersToPoints(15)

Mit dem Hinweis, der Remote-Server-Computer existiert nicht oder ist nicht verfügbar

0
IchMalWiederXY  20.06.2022, 19:18
@fx8350

Diese Meldung mit dem "Remote Server" hatte ich vor kurzen bei einer ähnlichen Aufgabe beim Einfügen von Bildern in ein PowerPoint.
Ich meine ich hätte vom FileImport auf Copy Paste import der Bilder umgestellt. Bin mir aber nicht mehr sicher.
Ggf spuken aber auch noch Objekte im Speicher und das Programm nicht weiß wo es lang muss. Also immer bewusst auch die
Set fd = nothing
um die Leerung herbeizuführen.
Ansonsten hätte ich NACH jedem Bild wieder einen Paragraph eingefügt um einen Abstand und auch eine individuelle Behandlung per Hand im Nachgang zu vereinfachen. Für zusätzliche Bilder danach hinter dem letzten Paragraph weitermachen.

0
fx8350 
Fragesteller
 21.06.2022, 06:48
@IchMalWiederXY

Ich habe inzwischen die Ursache gefunden. Offensichtlich hat es damit zu tun, dass Word geschlossen wurde. Also ich müsste irgendwie eine Prüfung einbauen, ob Word, bzw. das Dokument bereits geöffnet ist und wenn nicht, dann erst Word öffnen. Also nicht mit GetObject, sondern mit CreateObject. Aber ich weiß gerade nicht wie ich das machen soll.

PS: Wie setze ich denn hinter jedes Bild eine Marke? Muss ich diese dann benennen?

0
IchMalWiederXY  21.06.2022, 12:48
@fx8350

Windows als System hält als Liste die Infos bereit, welches Programm oder Service am Laufen ist. (Im TaskManager zum Beispiel von Hand einsehbar)
Auf diese Liste kann man zugreifen und darin z.B Word suchen.
Auch hierfür gibt es den Code im Web. (Hatte ich auch dorther erhalten)
===
Firmen lassen gerne Programme zur Mitarbeiter Überwachung laufen.
Diese kann man auf diese Weise automatisch stoppen.

0
fx8350 
Fragesteller
 21.06.2022, 13:02
@IchMalWiederXY

Ich habe jetzt zwar einen funktionierenden Code der prüft, ob das Objekt bereits geöffnet ist, aber ich erhalte noch immer den Fehler mit dem Remote-Server.

Für mich ist das alles sehr schwierig, da ich hier stundenlang nach Lösungen suche und nicht fündig werde.

Dafür bin ich auch einfach nicht gut genug. Deshalb frage ich ja nach...

Ich finde auch nicht heraus, wie ich jedes eingefügte Bild in eine (neue) Textmarke setze, wie in Deinem Vorschlag. Auch wäre es mir lieber, wenn nur noch Bilder skaliert werden, die noch nicht skaliert sind...

Oh man.

0
fx8350 
Fragesteller
 22.06.2022, 15:09
@fx8350

Ich habe es zumindest nun geschafft, dass der Code auch beim zweiten Mal Öffnen durchläuft. Die anderen Punkte werde ich dann erst einmal ignorieren...

Public Sub AddPics()
    Dim fd As Office.FileDialog, sfiles As Variant, rng As Object, shp As InlineShape, iWidth As Single
        
    Set wks = ThisWorkbook.Worksheets("Tabelle1")
    
    Zeile = ActiveCell.Row
    
    bez = wks.Range("bez").Column
    stck = wks.Range("stck").Column
    gesperrt = wks.Range("gesperrt").Column
    zuständig = wks.Range("zuständig").Column
    fehler = wks.Range("fehler").Column
    
    aName = wks.Cells(Zeile, 1).Value & "-" & wks.Cells(Zeile, bez) & ".docx"
    
    Path = "XXX" & Year(Now) & "\"

    File = Dir(Path & aName)

    'Prüfen ob Word gestartet ist und ggf. öffnen
    On Error Resume Next
    Set Wdoc = GetObject(Path & File)
    Set wrd = Wdoc.Application
    If Err.Number = 429 Then
    Err.Clear
    
    Set wrd = CreateObject("Word.Application")
    Wdoc = wrd.Documents.Open(Path & File)
    If Err.Number = 429 Then
    Err.Clear
    MsgBox "Es konnte nicht auf Word zugegriffen werden! Vielleicht ist Word nicht installiert!", vbExclamation, "Fehler beim Zugriff auf MS Word"
    End If
    End If
    On Error GoTo 0
    
    wrd.ScreenUpdating = False
    
    'Dateidialog öffnen
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
    .Title = "Bilder auswählen"
    .AllowMultiSelect = True
    .ButtonName = "Auswählen"
    .Filters.Clear
    .Filters.Add "Bilder", "*.gif; *.png; *.jpg; *.jpeg", 1
    .FilterIndex = 1
    .InitialFileName = "C:\Users\Public\Pictures"
    .Show
    End With

    If fd.SelectedItems.Count > 0 Then
    
    With wrd
    Select Case File
    Case Is = ""
    msg = MsgBox("Keine Fehlermeldung gefunden!", vbOKOnly + vbExclamation, "Warnhinweis!")
    Exit Sub

    Case Else
    
    '.Documents.Open (Path & File)
    .Visible = True
    .Activate
    
    With Wdoc
    
    'Textmarke "seitenende" in Fehlermeldung als Range festlegen und auswählen
    Set rng = .Bookmarks("seitenende").Range
    .Bookmarks("seitenende").Range.Select
    
    'Inlineshapes instanzieren
    'Set shp = .InlineShapes.New
    
    For Each sfiles In fd.SelectedItems
    
    'Ausgewählte Bilder einfügen
    Set shp = rng.InlineShapes.AddPicture(FileName:=sfiles)
    
    Next sfiles
    
    'Bilder skalieren

    For Each shp In .InlineShapes
    
    shp.LockAspectRatio = msoTrue
            
    shp.Width = wrd.CentimetersToPoints(15)
    iWidth = shp.ScaleWidth
    shp.ScaleHeight = iWidth
    
    Next shp
    
    'Zeilenabstand zwischen den Bildern setzen
    .Bookmarks("seitenende").Range.Paragraphs.LineSpacingRule = wdLineSpaceDouble
    
    'Textmarke neu setzen
    .Bookmarks.Add "seitenende", rng
    
    'Word Dokument speichern
    .SaveAs "Q:\QS_Baecker\Interne Fehlererfassung\" & Year(Now) & "\" & aName

    End With
    End Select
    End With
    End If
    
    'aufräumen
    Wdoc.Close
    wrd.Quit
    Set rng = Nothing
    Set fd = Nothing
    Set shp = Nothing
    Set wrd = Nothing
    Set Wdoc = Nothing
    
    Set wks = Nothing
End Sub
0
IchMalWiederXY  22.06.2022, 17:59
@fx8350

naja. Mit manchen deiner Wünsche bist du in den Untiefen der verschiedenen Objekte unterwegs. Im Zweifel auf Englisch suchen.
ABER.
Warum denn ein WORD erstellen. Mir scheint du machst einen (Fehler) Bericht.
So etwas macht man in PowerPoint oder PDF ODER einer QS WebSeite.
Diese drei Wege habe ich ebenfalls schon programmiert. WebSeite und PowerPoint können sich in Eigenregie um das Format kümmern.
ODER man speichert nur die ROH Daten (In bestimmten Format) auf dem Server und lässt Google Graphs die Bildchen zeichnen.
Hier mal der Code mit dem man die offenen Applikationen bekommt. Deine Variante ist nicht zielführend:
How to list all opening (currently running) applications in Excel? (extendoffice.com)

1
fx8350 
Fragesteller
 23.06.2022, 12:22
@IchMalWiederXY

Hi, eigentlich sind das Aufgaben die ein ERP System können sollte. Ich versuche nur auf die Schnelle mich selbst zu entlasten. Das Ergebnis ist schon so gewollt. Das Word Dokument soll über Excel (hätte ggf. auch Access nehmen sollen) ausgefüllt, Bilder werden eingefügt und dann wird das Dokument später als pdf verschickt.

Über eine UserForm sollen aber entsprechende Mitarbeiter das Word Dokument zuende ausfüllen. Der Automatismus dient nur der Vereinfachung, da wir viele Fehlermeldungen haben.

Ich bin ja auch kein Programmierer, eigentlich bin ich 3D-Koordinatenmesstechniker und Qualitätstechniker. Ich mache das um mir Zeit zu ersparen. Klappt jetzt auch ganz gut.

Leider funktioniert nun ein anderes Sub nicht mehr, weshalb ich langsam resigniere. Und da geht es um ReSetBookmark.

Vielleicht habe ich ja durch einen Crash irgendwie einen Bug reingeholt, den man nicht sehen kann. Hatte früher mal ein defektes Modul. Neu erstellt und es ging. Aber das geht hier nicht, leider.

0
IchMalWiederXY  23.06.2022, 22:16
@fx8350

mmhh:
Bookmarks dynamisch setzen und entfernen habe ich auch schon gemacht.
Alle diese Elemente kommen als collection im Object vor und man kann mit

"For each" über alle Bookmark Elemente iterieren, sie im Document auffinden, und dann beeinflussen. Warum allerdings bookmarks vorkommen müssen für das Bilder Einfügen erschließt sich mir nicht.

1
fx8350 
Fragesteller
 29.06.2022, 08:51
@IchMalWiederXY

Hi, es müssen für die Bilder keine Bookmarks sein. Ich konnte sie nur gut ansprechen. Eigentlich möchte ich, dass die Bilder ab der zweiten Seite eingefügt werden. Mit dem Bookmark geht es. Nur wenn ich weitere Bilder einfüge, werden sie an den Anfang gestellt. Ich möchte nachträglich hinzugefügte Bilder aber gerne hinter die vorhandenen setzen.

Wie kann ich denn sonst Bilder ab der zweiten Seite einfügen und sicherstellen, dass neue Bilder dahinter gestellt werden?

0
IchMalWiederXY  29.06.2022, 09:01
@fx8350

Ein wichtiges Element sind "Paragraphen" in Word. Wo sich jeder Paragraf befindet "Reihenfolge" und auf welcher Seite ist im WordObjekt vorhanden.
Wenn Bilder IMMER am Ende (mindestens) aber auf der 2ten Seite eingefügt werden sollen, dann ggf über die Paragraphen Position dies tun.
ABER. Ein ganz leeres Word Dokument hat nur 'einen' Paragraphen direkt auf der ersten Seite. Hier müsste man ggf ZUERST eine "SeitenWechsel" Einfügen, damit es zumindest den "2ten" wichtigen für den Start auf der 2ten Seite ist.
In PowerPoint gibt es "GrafikPlatzHalter", die hier die Dinge vereinfachen für genau diese Aktion. Ob es solche auch für WORD gibt weiß ich nicht auswendig. (Könnte dann ggf ne Vereinfachung deiner Umsetzung darstellen.
===
Der GrafikPlatzHalter ist zunächst LEER aber bereits an der richtigen Position. ->Vorbereitetes PowerPoint (oder Word) Template. Dann diesem PlatzHalter das Bild zuweisen, fertig.

1
fx8350 
Fragesteller
 29.06.2022, 14:55
@IchMalWiederXY

Ok danke, ich muss mir das mit dem Paragraphen mal ansehen. Die erste Seite vom Word-Dokument ist nie leer. Ich muss mal schauen...

0
fx8350 
Fragesteller
 04.07.2022, 14:24
@fx8350

Hi, ich checke es nicht. Was mich mit meiner jetzigen Methode ärgert, ist die Tatsache, dass Bilder, welche ich nachträglich einfüge, nicht als letztes angezeigt werden, sondern als erstes (falsche Reihenfolge). Dazu kommt, dass eben jedes Mal alle Bilder geprüft und auf richtige Breite eingestellt werden. Das dauert dann länger.

Ich finde mich nicht zurecht wie ich es besser machen kann, dazu fehlt mir die Ahnung. Aber danke für Deinen Hinweis, leider war die Lösung nicht dabei.

0
IchMalWiederXY  04.07.2022, 19:51
@fx8350

Dein "Range" geht auf "Seitenende" und NICHT auf den letzten Paragraph.
ActiveDocument.Paragraphs.Last.
Damit die vorhandenen Bilder NICHT mehr bedient werden darfst du dich nur um die "neuesten" kümmern.
Hier wäre es wicht den aktuellen Code in Portionen zu zerlegen und nur dann laufen zu lassen, wenn sie wirklich benötigt werden.
Wir können dir hier keine Software Technik beibringen, oder auch jede Lösung passgenau posten.

1
fx8350 
Fragesteller
 07.07.2022, 15:28
@IchMalWiederXY

Du hast Recht, das geht nur in Foren, wo sich die Leute der Sache aus Spaß annehmen und nicht Überflieger sind, wie in manch anderen Portalen und meinen, das Wissen nicht weiter zu geben. Ich lerne wirklich viel, aber gewisse Punkte verstehe ich nicht, daher frage ich nach. Und das hat nichts mit passgenauer Lösung zu tun.

Ich bekomme vielleicht hin, wie ich nur neu hinzugefügte Bilder bearbeite, aber ich finde einfach nicht raus, wie ich diese Paragraphen anspreche, weil ich nicht weiß wie das mit Paragraphen geht.

Meine Range geht nicht auf Seitenende, sondern ist eine geschlossene Textmarke.

Ich werde weiter Google benutzen, irgendwann finde ich dann auch hierfür etwas zum Nachlesen, was mir hilft es zu verstehen.

Ich danke Dir aber für die Hilfe, die ich phasenweise erhalten habe, wenn ich phasenweise welche benötigt habe.

0