-
Batch photo insert for reporting
I'm an absolute caveman when it comes to VBA. My skills are capped at scouring forums, copy pasting, and failing repeatedly.
The following is a result of Frankenstein-ing and mild editing but it appears to work at resizing and halfway captioning the images. I would however, like the images to be captioned with the Folder name. Let's say the folder is called 'Basement', how can I get the caption to read 'Figure ## - Basement' where ## is figured magically by the following macro:
Sub Caption()
'
' Caption_Image Macro
'
'
Dim objPic As InlineShape
For Each objPic In ActiveDocument.InlineShapes
objPic.Select
Selection.InsertCaption Label:="Figure", TitleAutoText:="", Title:="", _
Position:=wdCaptionPositionBelow, ExcludeLabel:=0
Next objPic
'
' Resize_Image Macro
'
'
Dim i As Long
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.ScaleHeight = 60
.ScaleWidth = 60
End With
Next i
End With
End Sub
-
You might try:
https://gregmaxey.com/word_tip_pages...ry_add_in.html
... I have a advanced customized version I sell.
-
I did check out your site earlier today and was pleased to see the quotes and quips bit - especially regarding Longfellow and the weather. "All sunshine makes desert" ain't it the truth!
I've got a nice thing going now with getting 8 pictures to a page (two columns of four). But it can be better! I'm trying to figure out how to add a piece to the beginning of the macro that will compress the photos to 96dpi. I have tried changing the settings in Word to always import the photos to 96dpi, but when I run the macro without first changing the images to 96dpi from the ribbon, it gets all beefed up. Compress to 96dpi from the ribbon and then run the macro - nice 2x4 columns.
Is there something I can just dump into the top of this that will compress the images for me? As mentioned earlier, I'm full caveman with this:
Sub A_TWO_FOUR_Apartment_203()
'
' Caption_Image Macro
'
'
Dim objPic As InlineShape
For Each objPic In ActiveDocument.InlineShapes
objPic.Select
Selection.InsertCaption Label:="Figure", TitleAutoText:="", Title:=" - Apartment 203", _
Position:=wdCaptionPositionBelow, ExcludeLabel:=0
Next objPic
'
' Resize_Image Macro
'
'
Dim i As Long
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.ScaleHeight = 90
.ScaleWidth = 90
End With
Next i
End With
End Sub
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules