#1
|
|||
|
|||
Help with VBA code to add plain text content control
Hello all. I found this forum and was hoping I could get some help. I found this code through a google search. The code allows me to open a word document, run the code, select photos to insert, and inserts two photos on the page with the file name below each photo. It is just what I was trying to do except I want a blank plain text content control box under each photo instead of the file name. Does this make sense?
I've tried to add code myself....which has not really worked out... Below is the code I have been using and trying to get to do what I need it to do. Any help would be much appreciated. Sub InsertMultipleImagesFixed() Dim fd As FileDialog Dim oTable As Table Dim iRow As Integer Dim iCol As Integer Dim oCell As Range Dim i As Long Dim sNoDoc As String Dim picName As String Dim scaleFactor As Long Dim max_height As Single 'define resize constraints max_height = 275 'add a 1 row 2 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 iCol = 1 iRow = i 'get filename picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "")) 'remove extension from filename **** picName = Left(picName, InStrRev(picName, ".") - 1) 'select cell Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range 'insert image oCell.InlineShapes.AddPicture FileName:= _ .SelectedItems(i), LinkToFile:=False, _ SaveWithDocument:=True, Range:=oCell 'resize image If oCell.InlineShapes(1).Height > max_height Then scale_factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height) oCell.InlineShapes(1).ScaleHeight = scale_factor oCell.InlineShapes(1).ScaleWidth = scale_factor End If 'center content oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter 'insert caption below image oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _ Title:=": " & picName, If i < .SelectedItems.Count And i Mod 2 = 0 Then 'add another row, more to go oTable.Rows.Add End If Next i End If End With Set fd = Nothing End Sub |
#2
|
||||
|
||||
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 |
Thread Tools | |
Display Modes | |
|
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 |
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 |
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 |