Word Macro

I need a Macro that will create a 2 column table and insert a text placeholder on the left side and pictures (chosen from a folder/group) on the right side. The columns will be the same size (50% left 50% right) Images will be sized 320x240 prior to import, but it would be nice if it resized if necessary. There will be 3 rows per page. Each row is added as needed. I would also like a little bit of padding between each cell in the table.

Microsoft Word 2003

Maybe this sample code below can be modified. It imports the pics and adds captions. I would like it to just put text in left column and pictures in right column and don't need to get the Image name.

Sub AddPics()
Application.ScreenUpdating = False
Dim oTbl As Table, i As Long, j As Long, k As Long, StrTxt As String
'Select and insert the Pics
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
If .Show = -1 Then
'Add a 2-row by 2-column table with 7cm columns to take the images
Set oTbl = Selection.Tables.Add(Selection.Range, 2, 2)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.Columns.Width = CentimetersToPoints(7)
'Format the rows
Call FormatRows(oTbl, 1)
End With
CaptionLabels.Add Name:="Picture"
For i = 1 To .SelectedItems.Count
j = Int((i + 1) / 2) * 2 - 1
k = (i - 1) Mod 2 + 1
'Add extra rows as needed
If j > oTbl.Rows.Count Then
Call FormatRows(oTbl, j)
End If
'Insert the Picture
ActiveDocument.InlineShapes.AddPicture _
FileName:=.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
'Get the Image name for the Caption
StrTxt = Split(.SelectedItems(i), "")(UBound(Split(.SelectedItems(i), "")))
StrTxt = ": " & Split(StrTxt, ".")(0)
'Insert the Caption on the row below the picture
With oTbl.Rows(j + 1).Cells(k).Range
.InsertBefore vbCr
.Characters.First.InsertCaption _
Label:="Picture", Title:=StrTxt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=False
.Characters.First = vbNullString
.Characters.Last.Previous = vbNullString
End With
End If
End With
Application.ScreenUpdating = True
End Sub
Sub FormatRows(oTbl As Table, x As Long)
With oTbl
With .Rows(x)
.Height = CentimetersToPoints(7)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
End With
With .Rows(x + 1)
.Height = CentimetersToPoints(0.75)
.HeightRule = wdRowHeightExactly
.Range.Style = "Caption"
End With
End With
End Sub

Taidot: Visual Basic, Word

Näytä lisää: create macro in word, word macro basic, visual basic word table cell, visual basic create word, word macro visual basic, pictures word, visual basic text column, group column macro, text column visual basic, images word text, word macro page, create macro, word basic macro, visual basic table cell, word import, create word page size visual basic, table word, create table word, visual basic word table, create word macro, macro group column, table padding, columns text macro, visual basic macro, pictures visual basic

About the Employer:
( 2 reviews ) Kennebunkport, United States

Projektin tunnus: #4235951

Myönnetty käyttäjälle:


Have bid for 2 hours. Please see PMB

$15 USD / tunti
(39 arvostelua)

7 freelanceria on tarjonnut keskimäärin 10 $/tunti tähän työhön


Hi I am very word vba.i have read the description and quite sure i am able to do the work with desired accuracy thanks

$5 USD / tunti
(134 arvostelua)

Hello, I am a .NET, VBA and VSTO software developer. I have nine years of experience in programming. I rest-assure that I will complete the work on time and deliver you the completed work to your satisfaction.

$5 USD / tunti
(37 arvostelua)

Consider it done! Please see more details on Inbox. Thanks

$12 USD / tunti
(1 arvostelu)

Please send me the sample to enable me to work out the details. I have done similar projects earlier. My rate as you please on satisfactory output of the sample.

$5 USD / tunti
(1 arvostelu)

Hi I am working as macro expert from 9 years and developed smilimar job before thanks

$10 USD / tunti
(0 arvostelua)

Hello. More 20 years programming experiense. See pmb, please.

$20 USD / tunti
(0 arvostelua)