Free Code Snippets in C#, Net Framework, Office 365, ASP.Net,WPF, Visual Studio, SQL Server, Antivirus free
#

Download:

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

    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 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
»
Word Template: Import a photo directory into a Word document

.

Contact for Jobs, Project Requests: raimund.popp@microsoft-programmierer.de