![]() |
|
#16
|
|||
|
|||
|
The more I think about it, this could save me a whole lot of hassle working for the different companies that I work for. Macropod, may I pay you to alter this for me a little bit? I would need two versions of this for two different report styles. 9 cm max vertical height on both. I couldn't have the font size type changed anywhere else in the document; only on the photo captions that I add 1. Calibri(body), 12 font, Justified across ~13.2 cm width. 2. Times New Roman, 12 font, Bold, Centered across normal margins. I think I could figure those out, but what I probably could not figure out is how I'd get them in the correct order. I would need to number the photos in order needed in the report followed by the caption text. I would only want the text to appear in the report, not the numerals. Filename examples: 1 top side of widget. 2 front side of widget. 3 bottom side of widget. etc. Any help would be great. |
|
#17
|
|||
|
|||
|
Can you please help to customize the code for fixed columns and rows and image autofit to entire cell. (for example 9 rows and 3 columns in each page and all image autofit )
|
|
#18
|
||||
|
||||
|
mathemagician44: The macro inserts captions so you should control the font size and typeface by modifying the Caption style.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
#19
|
||||
|
||||
|
Please read post #2 in this thread.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#20
|
|||
|
|||
|
Changing the Code to suggested Fix Code for Captions to be above pictures, I'm getting an error. @ -- .Styles
error: Method or Data Member Not Found Can you assist? Thanks |
|
#21
|
||||
|
||||
|
On which line are you getting that error?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#22
|
|||
|
|||
|
Section Changed:
Code:
With .Styles("TblPic").ParagraphFormat
.Alignment = wdAlignParagraphCenter
.KeepWithNext = False
CaptionLabels.Add Name:="Picture"
.Styles("Caption").ParagraphFormat.KeepWithNext = True
.SpaceAfter = 0
.SpaceBefore = 0
End With
-----------------------------------------
.Styles("Caption").ParagraphFormat.KeepWithNext = True
|
|
#23
|
||||
|
||||
|
The code you've posted does not reflect the instructions in post #2.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#24
|
|||
|
|||
|
Hi macropod!
Hope you'll fine... I need little change in this code... I want to make text as "Centerline", color default "Black", font style "Cournier New" . thanks |
|
#25
|
||||
|
||||
|
To do that, you should modify Word's Caption Style. You don't need code for that. This was already advised in post #18.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#26
|
|||
|
|||
|
Hi, I also have the error on the .Styles("caption")... line when trying to add the caption above the picture, as another user.
I placed it as per the instructions in post #2. Anyone can point out what i'm doing wrong? (It works perfectly when addin the caption below the image) Code:
Sub AddImageTable()
'Sourced from: https://www.msofficeforums.com/47919-post2.html
Application.ScreenUpdating = False
Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long, iShp As InlineShape
Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single, ColWdth As Single
On Error GoTo ErrExit
NumCols = oColumnsCount.Value 'CLng(InputBox("How Many Columns per Row?"))
' RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in Centimeters (e.g. 5)?")))
RwHght = CentimetersToPoints(CSng(oRowsHeight.Value))
On Error GoTo 0
'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
'Create a paragraph Style with 0 space before/after & centre-aligned
On Error Resume Next
With ActiveDocument
.Styles.Add Name:="TblPic", Type:=wdStyleTypeParagraph
On Error GoTo 0
With .Styles("TblPic").ParagraphFormat
.Alignment = wdAlignParagraphCenter
'Insert caption below (true) or above (false) the picture
.KeepWithNext = oCaptionsBelowImage.Value
.SpaceAfter = 0
.SpaceBefore = 0
End With
End With
'Add a 2-row by NumCols-column table to take the images
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
With ActiveDocument.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / NumCols
End With
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.TopPadding = 0
.BottomPadding = 0
.LeftPadding = 0
.RightPadding = 0
.Spacing = 0
.Columns.Width = ColWdth
.Borders.Enable = oShowBorders.Value
End With
CaptionLabels.Add Name:="Picture"
'ERROR next line: .styles : method or data member not found
.Styles("Caption").ParagraphFormat.KeepWithNext = Not oCaptionsBelowImage.Value 'True To insert the captions above the pictures
For i = 1 To .SelectedItems.Count Step NumCols
r = ((i - 1) / NumCols + 1) * 2 - 1
'Format the rows
Call FormatRows(oTbl, r, RwHght)
For c = 1 To NumCols
j = j + 1
'Insert the Picture
Set iShp = ActiveDocument.InlineShapes.AddPicture( _
FileName:=.SelectedItems(j), LinkToFile:=oLinkToFile.Value, _
SaveWithDocument:=True, Range:=oTbl.Cell(r + IIf(oCaptionsBelowImage.Value = True, 0, 1), c).Range)
'SaveWithDocument:=True, Range:=oTbl.Cell(r , c).Range 'To insert the captions below the pictures
'SaveWithDocument:=True, Range:=oTbl.Cell(r + 1, c).Range 'To insert the captions above the pictures
With iShp
.LockAspectRatio = True
If (.Width < ColWdth) And (.Height < RwHght) Then
.Width = ColWdth
If .Height > RwHght Then .Height = RwHght
End If
End With
'Get the Image name for the Caption
StrTxt = Split(.SelectedItems(j), "\")(UBound(Split(.SelectedItems(j), "\")))
StrTxt = ": " & Split(StrTxt, ".")(0)
'Insert the Caption on the row below the picture
With oTbl.Cell(r + IIf(oCaptionsBelowImage.Value = True, 1, 0), c).Range
'With oTbl.Cell(r + 1, c).Range 'To insert the captions below the pictures
'With oTbl.Cell(r, c).Range 'To insert the captions above the pictures
.InsertBefore vbCr
.Characters.First.InsertCaption _
Label:="Picture", Title:=StrTxt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=False
.Characters.First = vbNullString
.Characters.Last.Previous = vbNullString
'or without Label:
'oTbl.Cell(r + 1, c).Range.Text =StrTxt
'To prevent overly-long captions wrapping:
If oShrinkCaptions.Value = True Then
If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
.Characters.First.Information(wdVerticalPositionRelativeToPage) Then
.FitTextWidth = ColWdth
End If
End If
End With
'Exit when we're done
If j = .SelectedItems.Count Then Exit For
Next
'Add extra rows as needed
If j < .SelectedItems.Count Then
oTbl.Rows.Add
oTbl.Rows.Add
End If
Next
If oConvertTableToText.Value = True Then oTbl.ConvertToText
Else
End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
Sub FormatRows(oTbl As Table, x As Long, Hght As Single)
With oTbl
With .Rows(x + IIf(oCaptionsBelowImage.Value = True, 0, 1))
'With .Rows(x) 'To insert the captions below the pictures
'With .Rows(x + 1) 'To insert the captions above the pictures
.Height = Hght
.HeightRule = wdRowHeightExactly
.Range.Style = "TblPic"
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
End With
' With .Rows(x + 1)
With .Rows(x + IIf(oCaptionsBelowImage.Value = True, 1, 0))
.Height = CentimetersToPoints(0.5)
.HeightRule = wdRowHeightExactly
.Range.Style = "Caption"
End With
End With
End Sub
|
|
#27
|
|||
|
|||
|
The line
Code:
.Styles("Caption").ParagraphFormat.KeepWithNext = Not oCaptionsBelowImage.Value
Code:
With Application.FileDialog(msoFileDialogFilePicker) Code:
ActiveDocument.Styles(wdStyleCaption).ParagraphFormat.KeepWithNext = Not oCaptionsBelowImage.Value |
|
#28
|
|||
|
|||
|
thanks, that was it
|
|
#29
|
|||
|
|||
|
Quote:
|
|
#30
|
||||
|
||||
|
The code would need to be completely re-written for that.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| How to insert and hide images | ricecrispies | Excel | 8 | 06-18-2022 04:19 AM |
| Mutliple Selection List Box | tbrynard01 | Word | 0 | 09-10-2019 12:56 PM |
| Insert images into word form | lfabiof | Word VBA | 1 | 12-24-2017 09:51 PM |
| Programmatically insert digital signature into a Word document | tinamanns | Word | 0 | 04-12-2017 01:16 PM |
Mutliple copies 167 print as one document
|
John-N | Mail Merge | 5 | 02-19-2012 07:15 PM |