Create Table for Multiple Pictures

[wave]

Hello, I've seen the code in http://www.vbaexpress.com/forum/showthread.php?65385-Inserting-multiple-images-into-Word-Table and It's very similar to what I need but since I'm very new to VBA I'm asking for your assistance.
Here's what i'm trying to achieve.
I need to insert imagens in a table like the code presented here, but I don't need the captions, thats easy and I've solved this problem.
My goal is, a table with 3 columns and 3 rows.
The first one with 8.43cm with second 0.3 and third 8.43, the bigger ones will be the places for images. The height will be 11.1 on the first row and 0.7 on the second and third. I've tried with a variation of this code

Sub FormatRows(oTbl As Table, x As Long, Hght As Single)
With oTbl
With .Rows(x)
.Height = InchesToPoints(Hght)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
End With
With .Rows(x + 1)
.Height = CentimetersToPoints(0.5)
.HeightRule = wdRowHeightExactly
.Range.Style = "Caption"
End With
End With
End Sub
But I was unsuccessfull.

The second thing is, on the very first cell of each page I want to add a repeating text (like a title) instead of a picture (with an input box). Is this possible to do?

Cheers
Tiago

[macropod]

Please don't hijack existing threads for quite different issues - which is what yours are. After all, all you've indicated that you need is a single 3*3 table. For what you've described, all that's required is:

Sub AddTable()
Application.ScreenUpdating = False
Dim oTbl As Table
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=3, NumColumns:=3)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(17.16)
With .Columns(1)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(8.43)
End With
With .Columns(2)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(0.3)
End With
With .Columns(3)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(8.43)
End With
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightExactly
.Rows(1).Height = CentimetersToPoints(11.1)
.Rows(2).Height = CentimetersToPoints(0.7)
.Rows(3).Height = CentimetersToPoints(0.7)
End With
Application.ScreenUpdating = True
End Sub
I have no idea what you mean by:

The second thing is, on the very first cell of each page I want to add a repeating text (like a title) instead of a picture (with an input box).
since all you've specified is a table that would fit comfortably onto a single page.

[wave]

Sorry maybe I din't explained myself correctly, here's what i mean:
25610

Like this, the first cell of each page has the description, witch I intend to do as an input box. If I select 1 to 3 imagens it fills one page, 4 to 6 it fills the second and on and on.

[macropod]

Well, that's an entirely different table structure to what you first described. To start with, you have 5 rows (per page), not 3. Plus you require not 1 'input box', but 3. It would have been be helpful if you had specified your actual requirements in full from the outset. No-one enjoys re-writing code just because key details were omitted from the original specs...

Sub AddPicTable()
Application.ScreenUpdating = False
Dim oTbl As Table, Rng As Range, iShp As InlineShape
Dim c As Long, i As Long, j As Long, r As Long
'Select the pictures to insert
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
.FilterIndex = 2
' If nothing is selected, exit
If .Show <> -1 Then Exit Sub
On Error Resume Next
'Create & define 3 paragraph Styles to be used in the first cell on each page
With ActiveDocument
.Styles.Add Name:="Title", Type:=wdStyleTypeParagraph
.Styles.Add Name:="Sub-Title", Type:=wdStyleTypeParagraph
.Styles.Add Name:="ID", Type:=wdStyleTypeParagraph
On Error GoTo 0
With .Styles("Title")
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.SpaceBefore = 48
.SpaceAfter = 96
End With
With .Font
.Name = "Arial"
.Size = 24
End With
End With
With .Styles("Sub-Title")
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.SpaceBefore = 24
.SpaceAfter = 48
End With
With .Font
.Name = "Arial"
.Size = 16
End With
End With
With .Styles("ID")
With .ParagraphFormat
.Alignment = wdAlignParagraphCenter
.SpaceBefore = 12
.SpaceAfter = 0
End With
With .Font
.Name = "Arial"
.Size = 12
End With
End With
End With
'Create the basic table and apply our Styles to the first cell
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=5, NumColumns:=3)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(17.16)
.LeftPadding = 0: .RightPadding = 0
.TopPadding = 0: .BottomPadding = 0
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
With .Range.ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceSingle
End With
With .Columns(1)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(8.43)
End With
With .Columns(2)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(0.3)
End With
With .Columns(3)
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(8.43)
End With
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightExactly
.Rows(1).Height = CentimetersToPoints(11.1)
.Rows(2).Height = CentimetersToPoints(0.7)
.Rows(3).Height = CentimetersToPoints(0.7)
.Rows(4).Height = CentimetersToPoints(11.1)
.Rows(5).Height = CentimetersToPoints(0.7)
With .Cell(1, 1).Range
.Text = vbCr & vbCr
.Paragraphs(1).Style = "Title"
.Paragraphs(2).Style = "Sub-Title"
.Paragraphs(3).Style = "ID"
End With
End With
'Replicate the basic table however many times are required
Set Rng = oTbl.Range
For i = 2 To -Int(.SelectedItems.Count / -3)
With oTbl.Range
.Collapse wdCollapseEnd
.FormattedText = Rng.FormattedText
End With
Next
'Insert the pictures
c = 0: r = -1
For i = 1 To .SelectedItems.Count
Select Case i Mod 3
Case 0: c = 3
Case 1: c = 3: r = r + 2
Case 2: c = 1: r = r + 3
End Select
Set iShp = oTbl.Range.InlineShapes.AddPicture( _
FileName:=.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range)
'Resize undersize pictures
With iShp
.LockAspectRatio = True
If .Width < oTbl.Cell(r, c).Width Then
If .Height < oTbl.Cell(r, c).Height Then
.Width = oTbl.Cell(r, c).Width
If .Height > oTbl.Cell(r, c).Height Then
.Height = oTbl.Cell(r, c).Height
End If
End If
End If
End With
Next
'Solicit the inputs & bookmark them
With oTbl
With .Cell(1, 1).Range
Set Rng = .Paragraphs(1).Range
Rng.Collapse wdCollapseStart
Rng.Text = InputBox("Input a Title", "Title Input", "Title")
.Bookmarks.Add "Title", Rng
Set Rng = .Paragraphs(2).Range
Rng.Collapse wdCollapseStart
Rng.Text = InputBox("Input a Sub-Title", "Sub-Title Input", "Sub-Title")
.Bookmarks.Add "SubTitle", Rng
Set Rng = .Paragraphs(3).Range
Rng.Collapse wdCollapseStart
Rng.Text = InputBox("Input an ID", "ID Input", "ID")
.Bookmarks.Add "ID", Rng
End With
'Cross-reference the bookmarks on each additional page
For r = 6 To .Rows.Count Step 5
With .Cell(r, 1).Range
Set Rng = .Paragraphs(1).Range
Rng.Collapse wdCollapseStart
.Fields.Add Rng, wdFieldEmpty, "REF Title", False
Set Rng = .Paragraphs(2).Range
Rng.Collapse wdCollapseStart
.Fields.Add Rng, wdFieldEmpty, "REF SubTitle", False
Set Rng = .Paragraphs(3).Range
Rng.Collapse wdCollapseStart
.Fields.Add Rng, wdFieldEmpty, "REF ID", False
End With
Next
.Range.Fields.Update
End With
End With
Application.ScreenUpdating = True
End Sub

[wave]

Sorry, I thought the table with 3r and 3c, could fit on one page. In the other computer It does, must be the margins.
Thank you for the code, it works great

Cheers

[macropod]

As coded, the result on my system is as per the images in your post #3, with an A4 page size using 25mm margins all round (the table is wider than the margins provide for, though).

[wave]

Thank you for all your help, It works great, now I'm trying to learn and understand all the code you wrote since I'm new at this.

Cheers

[macropod]

I've added some comments to the code to describe what's being done in each part.

[wave]

Thank you Paul,
Just one more thing, how can i autofit the pics to the cells size? I can only fit the first one.

[macropod]

Unless they're too small, the pics will automatically scale to achieve a best-fit in the cells at the correct aspect ratio. And, unless they're in portrait format with a 1.326:1 (or 1:0.754) h:w aspect ratio, making them fill the cells would result in either a distortion of the aspect ratio or cropping of the image.

[wave]

I think they're too big. But When i format them manualy, only changing the h to 11 (the w also changes automaticaly), they fit perfectly to the table.

[macropod]

When Word inserts a picture into a table cell with a fixed height and width, any image that is too big to fit within the cell at the correct aspect ratio is scaled down to fit. The behaviour is by design. Unless your 'Normal' paragraph format applies a non-zero 'space before' and/or 'space after', it's impossible for your images to be 'too big' and require scaling up to fit.

[wave]

Thank you for the trouble. You've been very helpfull :D
I'll try to see what I can do, and if i figure something out I'll post it here.

Cheers

[macropod]

I've added some code to resize any undersize pictures.

[wave]

Thank you. Actually I worked it out this afternoon but I left the code on the other computer. Since all my imagens follow the aspect 7:5 and I don't mind a little distortion I defined the resize of every picture to 11:8 and it worked.
Now I'm working on the text of the first cell to always be correctly sized no matter the number of characters that I write. For example if the title has a lot of characters the ID disappears. I think I'll need a few "if" conditions but I hadn't thought a lot about it.

You're great at vba and I really appreciate the time you've dedicated to this. Thank you!
Cheers

[macropod]

Since all my imagens follow the aspect 7:5 and I don't mind a little distortion I defined the resize of every picture to 11:8 and it worked.

In that case, you really should have given the cells the 7:5 aspect ratio (e.g. 11.1cm*7.93cm and an overall table width of 16.16cm [which would also be a better fit on the page]). That way you wouldn't need to distort or resize the pics.


Now I'm working on the text of the first cell to always be correctly sized no matter the number of characters that I write. For example if the title has a lot of characters the ID disappears. I think I'll need a few "if" conditions but I hadn't thought a lot about it.
In that case, you can change the before/after paragraph space settings and/or the font size for one or more of the Styles so that you don't run out of space.

[wave]

Yes that seams a good idea. But i don't see almost any distortion. Tomorrow I'll change it.
As for the other part, I've changed it already and for most titles and sub titles it works. But like I said there are some texts that are too big and I just need to make it adjustable.

One more question I've added a fixed text to the 2 and 5th rows but when I add a new style to format the text and then call it afterwards it gives me and error and it doesn't go past it, any ideia about what it could be?

[macropod]

Yes that seams a good idea. But i don't see almost any distortion. Tomorrow I'll change it.
As for the other part, I've changed it already and for most titles and sub titles it works. But like I said there are some texts that are too big and I just need to make it adjustable.As I said, though, changing the before/after paragraph space settings and/or the font size for one or more of the Styles should take care of that.



One more question I've added a fixed text to the 2 and 5th rows but when I add a new style to format the text and then call it afterwards it gives me and error and it doesn't go past it, any ideia about what it could be?
Without seeing how you've implemented that, I can't say.

[wave]

I followed your advice and aplied this

With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.Height = CentimetersToPoints(11.1)
.Width = CentimetersToPoints(7.93)
End With
Next i
End With
It's simple and it works fine. Today I haven't had much time to make more adjustments but on the first cell I made the changes that you've sugested. As far as Styles go, I don't think I need it anymore :D

[macropod]

That is NOT what I said you should do. What I said is that you should change the column widths and table width...