Hi all,
I’ve been working on this script for my 86 year old father. He has whole bunch of images (with titles on them) that need to be insert (or replace existing) in a word document, albeit with the title added automatically as an caption.
I tried the option (asked Uncle Google) of using Tables and inserting the Picture in one Cell and the Caption in another below. But this does not work at all, as it is very difficult to re-position the table once it is in Word.
So I tried to simulate the Word command “Insert Caption” using a normal (floating) shape with the caption inserted in a text box just below the picture. This now works (after a long battle with the positioning of the image on the page).
However … When I run this script on my MB Air, it is slow, but acceptable. On my fathers iMac (Late 2012, with 12 GB Memory, High Sierra 10.13.2) it is VERY slow. it takes over a minute to get transfer the image (run the script).
Am I doing something terribly wrong? (the older version, the one using tables did not have this issue)
Here’s the script:
-- Export selected Picture from Photos. Import it into Microsoft Word and add the "Photos"'s Title attribute as Caption below it.
--
-- (c) Sverrir Jonsson, December 2017
--
-- Used to trannsfer the selected picture in "PHOTOS" to "Microsoft Word"
-- Script called from MS Word using the "AppleScript" function)
-- Note:
-- Some of the logic is coded in VBA in Word. Stuff like the exct positioning of the image (snap to left|right margin etc)
-- If someone wants to see the whole thing just drop me a note....
--
-- There are a quite a few posts showing a Table based solution to the problem of automatically adding a caption to an image
-- but it is almost impossible to move the Tables around or to re-size them.
-- There is one caveat though. After the script has returned, the use needs to manually group the Image and the Caption.
-- This is due to a "bug" in both the MS Word AppleScript lbrary, as well as the VBA Object Model on the Mac.
--
-- One more thing: There are no proper Error Handlers (Try...) will add those during next re-factoring
--
-- Test setup:
-- To test this script, create a word document, type in at least 100 characters (just hit some random keys...)
-- then comment out the following line.... before hitting RUN, open Photos and select one picture
--set myresults to InsertImageWithCaption("NewPicture!Figure!Caption!1100!50!50!1!1!0!0!18000!58320!0!15110") as string
on InsertImageWithCaption(asParam)
set asStatus to "Error" as string
set destFolder to "WordTemp" as string
set imageTitle to "" as Unicode text
set destpath to "" as string
set results to "" as string
set imageID to "" as string
-- Split the Parameter string from Word.
-- Note: Position and size paramters are all multiplied by 100. Need to be divided again (done to avoid passing decimals - Avoid isssues with Point and Comma conversion)
log asParam
set tid to AppleScript's text item delimiters
set AppleScript's text item delimiters to "!"
set myParams to text items of asParam
set AppleScript's text item delimiters to tid
set myAction to item 1 of myParams
set myCaptionLabel to item 2 of myParams
set myCaptionStyleSheet to item 3 of myParams
set myCaptionHeight to (item 4 of myParams) / 100
set myAnchorStart to (item 5 of myParams) + 1
set myAnchorEnd to (item 6 of myParams) + 1
set myRelHorPos to item 7 of myParams
set myRelVerPos to item 8 of myParams
set myWrapType to item 9 of myParams
set myWrapSideType to item 10 of myParams
set myLeftPos to (item 11 of myParams) / 100
set myTopPos to (item 12 of myParams) / 100
set myHeight to (item 13 of myParams) / 100
set myWidth to (item 14 of myParams) / 100
tell application "Photos"
activate
end tell
-- Here comes the Magic Export and re-size the currently selected image in "Photos".....
set {destpath, imageTitle, imageID} to ExportSelectedImage(myWidth)
set pictureAltText to imageTitle & "|" & imageID & "|" & (current date)
-- Now deal with Microsoft Word .... This is done in Applescript to avoid conversion errors when transferring unicode text
tell application "Microsoft Word"
activate
-- set screen updating to false ' Bug: Not implemented in AS Library ...
-- crate anchor based on current selection....
set myRange to create range active document start (start of content of text object of selection) + 1 end (end of content of text object of selection) + 1
set myAnchor to create range active document start (start of content of text object of selection) + 1 end (end of content of text object of selection) + 1
-- log "myAnchor: Start= " & (start of content of myAnchor) & ", End= " & (end of content of myAnchor)
if myAction = "ReplacePicture" then
delete selection
end if
-- Note: THe image comes in at full size. Would be better to include the size paramters in the "make new picture" command,
-- but the "keep aspect ration" element, does not work during "make"
set pictureShapeNew to make new picture at myRange ¬
with properties {file name:destpath as text, save with document:true, anchor:myAnchor, relative vertical position:myRelVerPos, relative horizontal position:myRelHorPos, top:myTopPos, left position:myLeftPos}
set wrap type of wrap format of pictureShapeNew to myWrapType
set wrap side of wrap format of pictureShapeNew to myWrapSideType
set allow overlap of wrap format of pictureShapeNew to true
-- Re-Size the image
set lock aspect ratio of pictureShapeNew to true
set width of pictureShapeNew to myWidth
set picHeightNew to height of pictureShapeNew
-- set height of pictureShapeNew to picHeightNew (Not needed, as aspect ration is locked)
set relative vertical position of pictureShapeNew to 1 -- wdRelativeVerticalPositionPage
set relative horizontal position of pictureShapeNew to 1 -- wdRelativeHorizontalPositionPage
-- Make sure the picture is positioned correctly. All position paramters are relative to the Page. This makes it easier to find the correct position
set left position of pictureShapeNew to myLeftPos
set top of pictureShapeNew to myTopPos
select pictureShapeNew
set myAnchor to create range active document start (start of content of anchor of pictureShapeNew) + 1 end (end of content of anchor of pictureShapeNew) + 1
-- Create a text box for the caption, just below the picture just inserted
set VposCaption to (top of pictureShapeNew) + picHeightNew + 2 -- 2 points below the image
set HposCaption to left position of pictureShapeNew
-- log "Vert. Pos Caption: " & VposCaption & ", Hor. Pos Caption: " & HposCaption
set myTBox to make new text box at active document with properties ¬
{text orientation:horizontal, anchor:myAnchor, relative vertical position:1, relative horizontal position:1, top:VposCaption, left position:HposCaption, width:myWidth, height:myCaptionHeight}
set wrap type of wrap format of myTBox to myWrapType
set wrap side of wrap format of myTBox to myWrapSideType
set allow overlap of wrap format of myTBox to true
-- Get the "Text Frame" from the "Text Box"
set myTextFrame to text frame of myTBox
set textwrapping allowed of myTextFrame to true
set myTextFrameRange to text range of myTextFrame
set style of myTextFrameRange to myCaptionStyleSheet
set text of myTextFrameRange to ""
insert caption at before myTextFrameRange caption label myCaptionLabel title (": " & imageTitle as Unicode text) caption position caption position below
-- Remove the empty paragraph in front of the Caption...
delete text object of paragraph 1 of myTextFrameRange
-- Need to fit the text box to the caption text..... "Manual auto fit...."
repeat while (overflowing of myTextFrame)
set myTBoxHeight to height of myTBox
set height of myTBox to (myTBoxHeight + myCaptionHeight - 4)
end repeat
-- Of course it would be niche to group he image and the caption, but the Word AS Library does not have a "Group" command
-- (And ... it does not work in VBA either ....)
select myTBox
set asStatus to "OK!" & (name of pictureShapeNew) & "!" & (name of myTBox) & "!" & (pictureAltText) as Unicode text
-- end tell
end tell
return asStatus
end InsertImageWithCaption
on ExportSelectedImage(picWidthNew)
set myHomeFolder to path to home folder as string
log "Home Folder: " & myHomeFolder
set destFolder to "WordTemp" as string
set imageTitle to "" as Unicode text
set destpath to "" as string
set results to "" as string
set imageID to "" as string
-- Make sure a temporary folder exists
tell application "Finder"
if not (exists folder destFolder of folder myHomeFolder) then
make new folder at myHomeFolder with properties {name:destFolder}
end if
set destFolder to myHomeFolder & destFolder & ":"
delete every item of folder destFolder
log "Destination Folder: " & destFolder
end tell
-- Now deal with Photos...
tell application "Photos"
set listSelectedPhotos to (get selection)
end tell
if listSelectedPhotos is {} then
tell application "Finder"
activate
display dialog "Only select one picture" buttons {"Ok"} default button 1
end tell
else
tell application "Photos"
-- activate
set selectedphoto to first item of listSelectedPhotos
set imageTitle to name of selectedphoto as Unicode text
set fname to filename of selectedphoto as text
set destpath to destFolder & fname as text
set imageID to id of selectedphoto
export listSelectedPhotos to (destFolder as alias) without using originals
end tell
-- Resize the Image exported from Photos to 330DPI, and max width of myWidth (specifified as 72 DPI value)
set destpath to ResizePicture(destFolder, picWidthNew)
end if
tell application "Photos"
-- Mark the Selected Photo as "Favorite" to make it easier to see if it has been used or not.
-- Also use two Keywords "Moved" and "Waiting" to be able to select only remaining items in Album
-- To use this feature, all pictures to be "processed" (or moved) should have the keyword "Waiting" applied in the Photos app
-- Need to pass the "Keywords" ("Waiting" [Biðstaða]] and "Transferred" [Flutt]) as Parameters..... Re-factoring task...
set myWaiting to "Waiting" -- "Biðstaða"
set myMoved to "Moved" -- "Flutt"
set KeyWordList to keywords of selectedphoto
-- log "Keywords : " & KeyWordList
if KeyWordList is missing value then
set KeyWordListNew to {myMoved}
else
set KeyWordListNew to {}
set itemsToDelete to {myWaiting, myMoved}
repeat with i from 1 to count KeyWordList
if {KeyWordList's item i} is not in itemsToDelete then set KeyWordListNew's end to KeyWordList's item i
end repeat
set KeyWordListNew's end to {myMoved}
end if
set keywords of selectedphoto to KeyWordListNew
set favorite of selectedphoto to true
end tell
return {destpath, imageTitle, imageID}
end ExportSelectedImage
on ResizePicture(destFolder, TargetWidth)
-- re-size the picture before moving it to Word
-- Assumption: use 330DPI to allow maximum quality printout.
-- The width for 330DPI will be calclated as follows: TargetWidth / 72 * 330
-- changed to 400, in order to allow some re-sizing of he image (upto +20%)
-- The height will by dynamic (keeping the aspect ratio)
-- Resulting image will always be in JPG format.
-- Calculate the 400DPI image width
set the target_length to round TargetWidth / 72 * 400 rounding as taught in school
-- get the exported file ... Should be the only file in the "WordTemp" Folder
tell application "Finder"
set TempFiles to every file of folder destFolder as alias list
set theFile to first item of TempFiles
end tell
tell application "Image Events"
-- start the Image Events application
launch
-- open the image file
set thisImage to open theFile
-- log "File is open: " & theFile as text
-- get dimensions of the image and scale it as required....
tell thisImage
copy dimensions to {W, H}
--log "Old Width: " & W & ", Old Height: " & H
-- determine the shortest side and then
-- calculate the new length for the longer side
if W is less than H then -- Portrait format
set the scale_length to round ((H * target_length) / W) rounding as taught in school
else -- Landscape format
set the scale_length to round target_length rounding as taught in school
end if
-- perform action
scale to size scale_length
-- save the changes
-- Note: always use the same file name to fool Apple´s Sandbox security mechanism
save as JPEG in destFolder & "MoveToWord.jpg" with compression level high with icon
-- purge the open image data
close
end tell
end tell
return destFolder & "MoveToWord.jpg" as Unicode text
end ResizePicture
Model: iMAC, late 2012
Browser: Safari 537.36
Operating System: Mac OS X (10.13 Developer Beta 3)