Consulting

Page 3 of 3 FirstFirst 1 2 3
Results 41 to 53 of 53

Thread: Insert Multiple Pictures Into Table Word With Macro

  1. #41
    VBAX Newbie
    Joined
    Jul 2014
    Posts
    2
    Location

    Hi see you can help me

    First of all i would like to say Im a native spanish speaker and probably my written english wont be the best and more than one mistake will take place.

    I tried Greg addins but doesnt work something in the code maybe, the gallery closes.

    I tried the code above given by Paul, but makes mi word close. Maybe is the size of the picture Im not sure.

    I liked the idea of image inside a table but im not sure if is my best way to format the report. I used to have an engenier that makes me the macros (Im a Geographer) and I only took a basic course of macros for excel, so word is winning me this time.

    Here is what I need.
    I got almost 100 images(screen print), need to paste 2 per page (so it will need resize to 42%) and above the image the file name. Inline to the paragraph,
    Until there it would be great.

    But if you are a magician of vba, the hole product will have some string under (next line): like this maybe

    image file name
    Image
    Sentido Ida: Sentido Retorno:
    1era Estación Ida: 1era Estación Retorno:

    Paul can you help me??

    or any one please!!
    Thanks in advance looking foward to hear replies

    Rocio

  2. #42
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    I have posted multiple macros in this thread, all of which work correctly. Other people have posted macros too, or links to them. Since I don't know which of my macros you're using, I can't possibly comment on why one of them might not work for you, especially given that you haven't mentioned anything about error messages and the like. As for Greg's macro, you'd need to discuss that with him.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #43
    VBAX Newbie
    Joined
    Jul 2014
    Posts
    2
    Location

    Sorry

    Hi Paul...

    I read you kind of mad... if so I sorry... I didnt name the problem because it apears in spanish I dont know how to translate it.
    About your macros posted aboved I work with it trying to solve the problem. And Actually I did fix it.
    But still is not MY BEST way because I dont want the images in a Table, as I posted above.
    Also I tried to modified and insert more lines in the table for the extra strings I need. And it only works if I choose 1 image... if I select more it does what it should as you programm it.

    as I told before this real hard for me, but Im not quitting.

    Sub AddPics()    Application.ScreenUpdating = False
        Dim oTbl As Table, i As Long, j 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 4-row by 1-column table with 15cm column width to take the images
                Set oTbl = Selection.Tables.add(Selection.Range, 4, 1)
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = CentimetersToPoints(15)
                     'Format the rows
                    Call FormatRows(oTbl, 1)
                End With
                CaptionLabels.add Name:="Figura"
                For i = 1 To .SelectedItems.Count
                    j = i * 2 - 1
                     'Add extra rows as needed
                    If j > oTbl.Rows.Count Then
                        oTbl.Rows.add
                        oTbl.Rows.add
                        Call FormatRows(oTbl, j)
                    End If
                     'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                    FileName:=.SelectedItems(i), LinkToFile:=False, _
                    SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(1).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(1).Range
                        .InsertBefore vbCr
                        .Characters.First.InsertCaption _
                        Label:="Figura", Title:=StrTxt, _
                        Position:=wdCaptionPositionBelow, ExcludeLabel:=False
                        .Characters.First = vbNullString
                        .Characters.Last.Previous = vbNullString
                    End With
                Next
            Else
            End If
        End With
        Application.ScreenUpdating = True
    End Sub
     '
    Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
            With .Rows(x)
                .Height = CentimetersToPoints(10)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
            With .Rows(x + 1)
                .Height = CentimetersToPoints(0.75)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
        End With
    End Sub
    Also I took your code and others found in other websites how to insert images, trying to solve my problem and do it without a table and keep the part of telling the name of the image and the number.... but I havent make it work yet. Probably because i dont know the commands well. and how to name what I want.

    Just came my boss to speak to me and told yeld it me because I havent got this this thing working yet... actually is frustraing to demand things from people there are not capable of... (sorry I know this paragrahs is not accurate to the theme) but im need to share it some how, because he left me crying.

    Paul... I really hope you can helpme

  4. #44
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    The code I have provided in this thread is only for inserting images and below them their captions into a table. If you want to do something different, you will need different code, or to add some manual procedures as well.

    For example, to insert the captions above the pictures you need to -

    change:
    SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range
    to:
    SaveWithDocument:=True, Range:=oTbl.Cell(r + 1, c).Range

    change:
    With oTbl.Cell(r + 1, c).Range
    to:
    With oTbl.Cell(r, c).Range

    change:
    With .Rows(x)
    to:
    With .Rows(x + 1)

    change:
    With .Rows(x + 1)
    to:
    With .Rows(x)

    And, if you don't want the final result to be in a table, insert:
    oTbl.ConvertToText
    before:
    Else
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #45
    VBAX Newbie
    Joined
    Jul 2014
    Posts
    1
    Location

    Question

    Quote Originally Posted by macropod View Post
    Try:
    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
                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
                        oTbl.Rows.Add
                        oTbl.Rows.Add
                        Call FormatRows(oTbl, j)
                    End If
                     'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                    FileName:=.SelectedItems(i), LinkToFile:=False, _
                    SaveWithDocument:=True, Range:=oTbl.Rows(j + 1).Cells(k).Range
                     'Get the Image name for the Caption
                    StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
                     'Insert the Caption on the row above the picture
                    oTbl.Rows(j).Cells(k).Range.Text = Split(StrTxt, ".")(0)
                Next
            Else
            End If
        End With
        Application.ScreenUpdating = True
    End Sub
     '
    Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
            With .Rows(x + 1)
                .Height = CentimetersToPoints(7)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
            With .Rows(x)
                .Height = CentimetersToPoints(0.75)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
        End With
    End Sub
    Hello,

    Thanks for that Code, I would like to use that macro to build a chart with 2 column, 3 row with a with of 9 cm per page.
    The picture and the text in the chart must be center and the size of the image must have a height of 6cm and a with of 8cm

    Can someone help me with that macro.

  6. #46
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by izno99 View Post
    I would like to use that macro to build a chart with 2 column, 3 row with a with of 9 cm per page.
    The picture and the text in the chart must be center and the size of the image must have a height of 6cm and a with of 8cm
    Be my guest. A careful reading of the code will show what changes need to be made for the height and width. As for the number of rows, that is controlled by how many pictures you select.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #47

    Turn off automatic caption numbering

    Hello, I want to say thank you very much for this code Paul it works very well. I would like to make one change for my purposes but can't seem to find in the code where to turn off the automatic incremental numbering "Picture 1" "Picture 2" etc.

    When I try
    ExcludeLabel:=True
    I get "1" "2"

    maybe I need a different type of caption?

    Thanks in advance

  8. #48
    VBAX Newbie
    Joined
    May 2016
    Posts
    1
    Location
    I am trying to modify your code, so that I can add multiple images, but with the option that the user can specify the number of rows and columns that will appear in a single page.
    I am using your code, with a bit of modifications in the image size:
    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, 4, 4)
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = CentimetersToPoints(4)
                     'Format the rows
                    Call FormatRows(oTbl, 1)
                End With
                CaptionLabels.Add Name:="Figura"
                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
                        oTbl.Rows.Add
                        oTbl.Rows.Add
                        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:="Figura", Title:=StrTxt, _
                        Position:=wdCaptionPositionBelow, ExcludeLabel:=False
                        .Characters.First = vbNullString
                        .Characters.Last.Previous = vbNullString
                    End With
                Next
            Else
            End If
        End With
        Application.ScreenUpdating = True
    End Sub
     '
    Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
            With .Rows(x)
                .Height = CentimetersToPoints(5)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
            With .Rows(x + 1)
                .Height = CentimetersToPoints(1.3)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Caption"
            End With
        End With
    End Sub
    n someone please help me?

  9. #49
    VBAX Newbie
    Joined
    Jun 2016
    Posts
    1
    Location
    Nice!

  10. #50
    VBAX Regular
    Joined
    Jun 2017
    Posts
    15
    Location
    I came across this website, and reviewed and applied this code - It is awesome. I need to make some tweaks to this, and I was wondering if anyone would help me.. I am a N00B when it comes to macros, and all I have done is goofed this up alot. Could anybody help me out?

    In addition, I would like to:

    centers pictures in table
    Inserts figure reference (Figure 1, etc. numerically)
    Would like a maximum of four images, which would take a majority of the page. The images would be likely 40%-50% current size.

    Any help or guidance would be much appreciated. heres the code:

    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
    
                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
                        oTbl.Rows.Add
                        oTbl.Rows.Add
                        Call FormatRows(oTbl, j)
                    End If
    
                     'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                    FileName:=.SelectedItems(i), LinkToFile:=False, _
                    SaveWithDocument:=True, Range:=oTbl.Rows(j + 1).Cells(k).Range
                     'Get the Image name for the Caption
                    StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
                     'Insert the Caption on the row above the picture
                    oTbl.Rows(j).Cells(k).Range.Text = Split(StrTxt, ".")(0)
                Next
            Else
            End If
        End With
        Application.ScreenUpdating = True
    End Sub
    
    
    Sub FormatRows(oTbl As Table, x As Long)
        With oTbl
            With .Rows(x + 1)
                .Height = CentimetersToPoints(7)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
            With .Rows(x)
                .Height = CentimetersToPoints(0.75)
                .HeightRule = wdRowHeightExactly
                .Range.Style = "Normal"
            End With
        End With
    End Sub





    Last edited by SamT; 06-30-2017 at 02:30 PM.

  11. #51
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Greg

    Visit my website: http://gregmaxey.com

  12. #52
    VBAX Regular
    Joined
    Jun 2017
    Posts
    15
    Location
    Greg,

    Many thanks. I am looking for something that is MACRO based, rathr than via add-on. Could you help me?

  13. #53
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Sharens, please start a new thread completely describing the issue, Post any code you already have, and as soon as you have 5 posts, please attach the Doc.

    I am locking this 5 yo thread now.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •