C#, WPF, vb.Net, vba, SQL Server, Access Programmierer, Excel, ASP Core MVC Webforms Telefon: 07022/9319004 freib. Software Entwickler   Kontakt
#

Download:

Datei 1: DEMO_Insert_Photos_From_Folder_Original.docm
Datei 2: DEMO_Insert_Photos_From_Folder_Original_97.docm

Word Makro: Alle Fotos einfügen von Eingabe-Ordner mit Makro

 

Word Datei .docm mit Makro im Hintergrund

für Word 2007 wurde die Sortierung erweitert, da Word 2007 alle Fotos direkt am Document Position 0 einfügt.

 

Video Tutorial

 

Beim Öffnen des Dokuments muss man nur den Verzeichnispfad zu dem Bild-Ordner in das Word-Eingabefeld eingeben

 

Und anschliessend unter Entwicklertools->Makros das Makro zum Einfügen durchlaufen lassen

 

Nach dem Ausführen des Makros sieht die Datei wie hier aus.

Alle Fotos wurden dem Dokument eingefügt als kleine jpg-Images mit kleiner Dateigröße

 

 

 

Kompletter vba Code im Hintergrund mit Alt-F11 erreichbar

Option Explicit On

 

Sub Macro_Insert_Photos_From_Folder()

    '-----------------< Insert_Photos_at_Position() >-----------------

    '*Insert Photos from a definite Folder after a Text-Bookmark

 

    '< setup >

    Const centimeters_height As Double = 7.5

    '</ setup >

 

 

    '< Init >

    Dim sBookmark_Name As String

    sBookmark_Name = "Fotos"

 

    '</ Init >

 

    '< get Document >

    Dim doc As Document

    Set doc = Application.ActiveDocument

    '</ get Document >

   

    '----< Jump to Bookmark >----

 

   

    '< check Bookmark >

    If Not doc.Bookmarks.Exists(sBookmark_Name) Then

        MsgBox "Ich kann die Textmarke Fotos nicht finden", vbCritical, "Textmarke Fotos fehlt"

        Exit Sub

    End If

    '</ check Bookmark >

 

    '

 

    '< Jump >

    doc.Bookmarks(sBookmark_Name).Select                'select the bookmark

    doc.Range(Selection.End, Selection.End).Select

    Selection.TypeParagraph                             'Insert new Line

    Selection.GoToNext wdGoToLine                       'jump to line after the Bookmark

    '</ Jump >

 

    '----</ Jump to Bookmark >----

 

    '-< check InputControl exists >-

    Dim bControl_Exists As Boolean

    bControl_Exists = False

 

    Dim control As ContentControl

    '---< Foldername >---

    For Each control In doc.ContentControls

        If control.Tag = "inputField_Foldername" Then

            bControl_Exists = True

            Exit For

        End If

    Next

    If bControl_Exists = False Then

        MsgBox "Das Eingabefeld Foldername existiert nicht", vbCritical, "Eingabefeld fehlt"

        Exit Sub

    End If

    '-</ check InputControl exists >

 

    '< Get Input_Field >

    Dim sFolderName As String

    sFolderName = control.Range.Text

    If sFolderName Like "" Then

        MsgBox "Das Feld Foldername: ist leer", vbCritical, "Check Foldername"

        Exit Sub

    End If

    '</ Get Input_Field >

    '---</ Foldername >---

 

 

 

    '------< Insert Pictures From Folder >------

    '< init >

    Dim sFolder_Path As String

    sFolder_Path = sFolderName

    '</ init >

 

    Dim objFileSystem As New FileSystemObject

 

    '< check >

    If Not objFileSystem.FolderExists(sFolder_Path) Then

        MsgBox "The folder " & sFolder_Path & " does not exist", vbCritical, "Check Entry Basefolder and Foldername"

        Exit Sub

    End If

    '</ check >

 

    '< init File-System >

    '*Reference Microsoft scripting Runtime    http://www.microsoft-programmierer.de/Details?d=1076

    Dim objFolder As Folder

    Set objFolder = objFileSystem.GetFolder(sFolder_Path)

    '</ init File-System >

   

    '----< @Loop: all Files >----

    On Error Resume Next

    Dim objFile As File

    For Each objFile In objFolder.Files

        If objFile.Type Like "JPG*" Then    'JPG-Datei

            '----< IsPhoto >----

            Dim sFilename As String

            sFilename = objFile.Path

 

            '< insert Photo after Bookmark >

            'SaveWithDocument:= True to save the linked picture with the document. The default value is False.

            'LinkToFile: True to link the picture to the file from which it was created. False to make the picture an independent copy of the file. The default value is False.

 

            Dim objShape As InlineShape

            Set objShape = doc.InlineShapes.AddPicture(FileName:=sFilename, LinkToFile:=False, SaveWithDocument:=True)

            '</ insert Photo after Bookmark >

           

            '< scale >

            objShape.LockAspectRatio = msoTrue

            objShape.Height = CentimetersToPoints(centimeters_height)    '5 Centimeters height

            '</ scale >

 

            '--< replace as png >--

            '*reduce memory 1 MB to 1kb

            '< cut >

            objShape.Select

            Selection.Cut

            '</ cut >

 

            '*pasteBitmap is much smaller

            Selection.PasteSpecial Link:=False, DataType:=wdPasteBitmap, Placement:=wdInLine, DisplayAsIcon:=False

            '--</ replace as png >--

 

 

            '< add spacer >

            'objShape.Select

            Selection.MoveRight

            Selection.TypeText Text:=Chr(11)

            Selection.TypeText Text:=Chr(11)

            DoEvents

            '</ add spacer >

 

 

            If Err.Number <> 0 Then

                MsgBox Err.Description

                Err.Clear

            End If

            '----</ Insert Image  >----

 

            '----</ IsPhoto >----

        End If

    Next

    '----</ @Loop: all Files >----

    '------< Insert Pictures From Folder >------

 

 

    '-----------------< Insert_Photos_at_Position() >-----------------

End Sub

 

 

Mobile
»
Word Makro: Alle Fotos einfügen von Eingabe-Ordner mit Makro
»
Word Vorlage: Kompletten Foto Ordner einlesen nach Basispfad und Ordnername
»
Word Vorlage: Foto-Dokumentation als Foto-Verzeichnis einlesen
»
Word Vorlage: Foto-Dokumentation
»
Word Vorlage: Foto Verzeichnis in ein Word Dokument einlesen
»
Word Vorlage: Einfügen von Fotos in mehrspaltige Tabelle
»
Word Makro: Fotos einfügen mit Auswahl Dialog mit Word Download-Datei
»
Word Makro: Alle Fotos mit einem Rahmen umranden
»
Word Makro: Einfügen von Fotos mit Datei-Auswahl in einer Liste
»
Word Makro: Alle Fotos Linksbündig mit Abstand einstellen

.

Jobs, Projekte, Angebote für Freiberufler, Selbstständig an Raimund.Popp@Microsoft-Programmierer.de