microsoft word macro help?

[d0wnt0wn]

Hi Guys i know this is not the right place to ask this question but i can not seem to find a similar forum for vba help in word like there is here and you guys have helped me so much in the past that I thought I would give it a shot.

I am trying to make a macro for word that will allow me to select multiple pictures from a folder location and insert them in to the document evenly sized and i would like a text box inserted directly below each picture (or beside the picture)

any help or a point in the right direction would be greatly appreciated.

Ken

 

[Trevor G]

Recorded code to insert a textbox

ActiveDocument.Shapes("Text Box 2").Select
ActiveDocument.AttachedTemplate.BuildingBlockEntries(" Simple Text Box"). _
Insert Where:=Selection.Range, RichText:=True

 

[d0wnt0wn]

yes that is how to make a text box in word with a macro but the code needs to be quite a bit more involved than that to get the desired effect plus it has to work in conjuction to what i already have. It seems that word vba just does not have the same support base that excel vba has... this has been very difficult to find a solution for.

Ken

 

[d0wnt0wn]

i actually just found some new code that inserts the pictures better size wise but still have the text box issue

Sub InsertMultipleImages()
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
If Documents.Count = 0 Then
sNoDoc = MsgBox(" " & _
"No document open!" & vbCr & vbCr & _
"Do you wish to create a new document to hold the images?", _
vbYesNo, "Insert Images")
If sNoDoc = vbYes Then
Documents.Add
Else
Exit Sub
End If
End If
'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 2)
'+++++++++++++++++++++++++++++++++++++++++++++
oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(7)
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"
.FilterIndex = 2
If .Show = -1 Then
For i = 1 To .SelectedItems.Count
If i Mod 2 = 0 Then
iRow = i / 2
iCol = 2
Else
iRow = (i + 1) / 2
iCol = 1
End If
Set oCell = oTable.Cell(iRow, iCol).Range
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=oCell
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter
If i < .SelectedItems.Count And i Mod 2 = 0 Then
oTable.Rows.Add
End If
Next i
End If
End With
Set fd = Nothing
End Sub

 

[Trevor G]

Look at this website to see if it helps

http://www.thezcorp.com/VBACodeSamples.aspx

And this one, which has a lot more to it.

http://www.kayodeok.btinternet.co.uk/favorites/kbofficeword.htm

By the way what does the Object Browser tell you?

In Word VBA Press F2 to invoke then you can search for Textbox etc and it should give you the steps.

 

[jimrward]

here is my code from many moons ago, no text box though just the filename under the pic, it will work on anything less than windows 7/office 2007 cos microsoft took away the filesearch mechanism

Sub pics()
'
' pics Macro
' Macro created 18/12/01
'
Dim File As String
Set myrange = ActiveDocument.Range(Start:=0, End:=0)
Call DoPageSetup
With Application.FileSearch
    .FileName = "*.jpg"
    .LookIn = "g:\malta"
    .Execute
    
    For i = 1 To .FoundFiles.Count
        File = .FoundFiles(i)

            Selection.InlineShapes.AddPicture FileName:=File, _
            LinkToFile:=False, SaveWithDocument:=True
            Selection.TypeParagraph
            Selection.Font.Size = 8
            Selection.TypeText Text:=File
            Selection.TypeParagraph
            Selection.TypeParagraph
    Next i
End With


End Sub

Sub DoPageSetup()

    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(0.4)
        .BottomMargin = CentimetersToPoints(1.4)
        .LeftMargin = CentimetersToPoints(0.4)
        .RightMargin = CentimetersToPoints(0.4)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(0)
        .FooterDistance = CentimetersToPoints(0)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
    End With
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
         = wdMasterView Then
        ActiveWindow.ActivePane.View.Type = wdPageView
    End If
    With ActiveDocument.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
        .Width = CentimetersToPoints(5.89)
        .Spacing = CentimetersToPoints(1.27)
    End With
End Sub