Freelance Project Requests Software Development in C# WPF Asp.Net Core Vba Excel Word SQL-Server EF Linq, UWP Net


Datei 1: DEMO_Insert_Photos_From_Folder_Original.docm



Word file .docm with macro in background


Video Tutorial


When you open the document, you only have to enter the directory path to the image folder in the Word input field


And then go to the Developer Tools-> Macros to run the Insert macro


After running the macro, the file looks like this.

All photos were added to the document as small jpg images with small file size




Complete vba code in the background with Alt-F11 accessible

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


    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

    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 >



            '</ cut >


            '*pasteBitmap is much smaller

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

            '--</ replace as png >--



            '< add spacer >



            Selection.TypeText Text:=Chr(11)

            Selection.TypeText Text:=Chr(11)


            '</ add spacer >



            If Err.Number <> 0 Then

                MsgBox Err.Description


            End If

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


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

        End If


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

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



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

End Sub



Word template for inserting von photos Version 55
Word Addin: Insert photos after a picture mark into a table
Photo documentaion in Word
Word Automatic Photo Documentation Template 1 Column 2 Photos with Numbers
Photo Template 4-Columns
Word Photo Template for Photo Documentation
Word macro: Insert all photos from input folder with macro
Word Template: Read the complete photo folder to base path and folder name
Word Template: Import photo documentation as a photo directory
Word Template: Photo Documentation


Contact for Jobs, Project Requests: