Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-13-2019, 11:31 PM
gmayor's Avatar
gmayor gmayor is offline Help with VBA code to add plain text content control Windows 10 Help with VBA code to add plain text content control Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default


Try the following, however you may find Photo Gallery Add-in Template useful

Code:
Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim oCell As Range
Dim i As Long
Dim oShape As InlineShape
Dim scale_Factor As Long
Dim max_height As Single
Dim oCC As ContentControl
    'define resize constraints
    max_height = 275

    'add a 1 row 1 column table to take the images
    Set oTable = Selection.Tables.Add(Selection.Range, 1, 1)
    '+++++++++++++++++++++++++++++++++++++++++++++
    'oTable.AutoFitBehavior (wdAutoFitFixed)
    oTable.Rows.Height = CentimetersToPoints(4)
    oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    '++++++++++++++++++++++++++++++++++++++++++++++

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .TITLE = "Select image files and click OK"
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
        .FilterIndex = 2
        If .Show = -1 Then

            For i = 1 To .SelectedItems.Count
                'select cell
                Set oCell = ActiveDocument.Tables(1).Cell(i, 1).Range
                oCell.End = oCell.End - 1
                'insert image
                Set oShape = oCell.InlineShapes.AddPicture(FileName:= _
                                                           .SelectedItems(i), LinkToFile:=False, _
                                                           SaveWithDocument:=True, Range:=oCell)

                'resize image
                If oShape.Height > max_height Then
                    scale_Factor = oShape.ScaleHeight * (max_height / oShape.Height)
                    oShape.ScaleHeight = scale_Factor
                    oShape.ScaleWidth = scale_Factor
                End If

                'center content
                oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

                'insert caption below image

                Set oCell = ActiveDocument.Tables(1).Cell(i, 1).Range
                oCell.End = oCell.End - 1

                oCell.Collapse 0
                oCell.Text = vbCr & vbCr
                oCell.Collapse 0

                Set oCC = oCell.ContentControls.Add
                With oCC
                    .Type = wdContentControlRichText
                    .TITLE = "Image " & i
                    .Tag = .TITLE
                    '.LockContentControl = True
                End With
                If i < .SelectedItems.Count Then oTable.Rows.Add
            Next i
        End If
    End With
    Set oShape = Nothing
    Set oTable = Nothing
    Set oCell = Nothing
    Set fd = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy Formatted Text in one Rich Text Content Control to another Rich Text Content Control Haygordon Word 1 04-05-2019 05:43 AM
Help with VBA code to add plain text content control Rich text/Plain text Content Controls in Template michael.fisher5 Word 9 11-19-2014 06:36 AM
Plain Text Content Control - Losing Styling on Carriage Return kintap Word 0 07-16-2014 12:43 PM
Help with VBA code to add plain text content control Creating a plain text content control for every instance of a word or phrase RobsterCraw Word VBA 16 11-20-2012 03:25 PM
Word2010 check boxes and plain text content control boxes in same table fcsungard Word 5 06-01-2012 01:16 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:02 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft