update all external linked bitmaps in entire document

Hi All,

I tried recording a macro to do this - nothing useful appears, and this has always been the case when recording macros FME. :-(

Then I looked through Os's Code to Re-import linked bitmaps at 100%, and added UpdateLink instead of Import. This didn't work... plus there's extra stuff I don't need here to simply update all links in entire document.

Next , I tried using the "code tag pair" in 3 ways, none work for me. All are shown here. What do I really need to type?

Sub loadSourceBitmap()
   Dim sr As ShapeRange, sh As Shape, lsr As New ShapeRange, errs$, cnt&, d11#, d12#, d21#, d22#, tx#, ty#
   On Error Resume Next
   Set sr = ActiveSelection.Shapes.FindShapes(, cdrBitmapShape)
   If sr.Count = 0 Then Set sr = ActivePage.FindShapes(, cdrBitmapShape)
   If sr.Count = 0 Then MsgBox "No images " + IIf(ActiveShape Is Nothing, "on this page", "in selection"): Exit Sub
   For Each sh In sr
      If sh.Bitmap.LinkFileName <> "" Then lsr.Add sh
      Next
   If lsr.Count = 0 Then MsgBox "No linked images " + IIf(ActiveShape Is Nothing, "on this page", "in selection"): Exit Sub
   ActiveDocument.BeginCommandGroup "Import fullres images"
   For Each sh In lsr
      Err.Clear: FileSystem.GetAttr sh.Bitmap.LinkFileName
      If Err.Number Then
         errs = errs + sh.Bitmap.LinkFileName + vbCr
      Else
         cnt = ActiveLayer.Shapes.Count
         ActiveLayer.UpdateLink sh.Bitmap.LinkFileName
         If cnt <> ActiveLayer.Shapes.Count Then
            ActiveShape.SetPosition sh.PositionX, sh.PositionY
            sh.GetMatrix d11, d12, d21, d22, tx, ty
            ActiveShape.SetMatrix d11, d12, d21, d22, tx, ty
         End If
      End If
   Next
   ActiveDocument.EndCommandGroup
   End Sub

[shelbym]

I fixed the code tag for you. You can find examples here:

http://forum.oberonplace.com/misc.php?do=bbcode

Hope that helps now to look at your code,

Shelby

[shelbym]

I am still not 100% sure what you are trying to do, but here what I have. Basically it just updates the link so you have the current version, then breaks the link bringing in the full res version into the document.

Sub LoadSourceBitmaps()
    Dim s As Shape
    Dim sr As ShapeRange
    
    Set sr = ActiveSelection.Shapes.FindShapes(, cdrBitmapShape)
    If sr.Count = 0 Then Set sr = ActivePage.FindShapes(, cdrBitmapShape)
    If sr.Count = 0 Then MsgBox "No images " + IIf(ActiveShape Is Nothing, "on this page", "in selection"): Exit Sub
    
    For Each s In sr
        If s.Bitmap.ExternallyLinked = True Then
            s.Bitmap.UpdateLink
            s.Bitmap.ResolveLink
        End If
    Next s
End Sub

[shelbym]

OK if you ask me this should do what you want. Only problem is it doesn't. At least on my pc. (I need to check service packs and will let you know what version I am running)

The problem is the s.Bitmap.ExternalLinkTime report the incorrect time. If have edited the bitmap today and linked it, it is actually in the future. Odd. More to come as I do some digging.

Sub FixOutdatedLinkedBitmaps()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim p As Page
    
    'Find all outdated linked bitmaps
    For Each p In ActiveDocument.Pages
        p.Activate
        Set sr = p.Shapes.FindShapes(, cdrBitmapShape, True)
        For Each s In sr
            If s.Bitmap.ExternallyLinked = True Then
                If DateDiff("s", FileDateTime(s.Bitmap.LinkFileName), s.Bitmap.ExternalLinkTime) <> 0 Then
                    s.Bitmap.UpdateLink
                End If
            End If
        Next s
    Next p
End Sub

Hi Shelby,

Thanks for your time :-) I was was getting frustrated.

the code below works OK for me after some small mods.

I took out the date stuff since there is already some native code in Draw that seems to compare between the preview bitmap and the real one.

The reason I put that concept in my email to you was because there might be a way for Draw to "auto-check" for changes once in a while. No worries, if not, the macro works well as is. Might freak people out if Draw is going off on a tangent every five minutes updating through a timer.

I add the optimization thing. Hopefully in right places.

I couldn't find the refresh link list function in VBA to put in at the end of the processing though. So the list still shows wrong thumbnails after processing, but Draw's page is good. (until refresh list is pressed)

Sub FixOutdatedLinkedBitmaps()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim p As Page
    
    'Find all outdated linked bitmaps
    For Each p In ActiveDocument.Pages
        p.Activate
        Set sr = p.Shapes.FindShapes(, cdrBitmapShape, True)
        For Each s In sr
            If s.Bitmap.ExternallyLinked = True Then
                    s.Bitmap.UpdateLink
            End If
            Optimization = True
        Next s
    Next p
    Optimization = False
End Sub

[shelbym]

Well hopefully we have gotten close. I don't know why the thumbnail bitmaps don't refresh, and you are right I don't see a call for it. Anyway here is what my final code would look like.

Sub FixOutdatedLinkedBitmaps()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim p As Page

    Optimization = True
    
    For Each p In ActiveDocument.Pages
        p.Activate
        Set sr = p.Shapes.FindShapes(, cdrBitmapShape, True)
        For Each s In sr
            If s.Bitmap.ExternallyLinked = True Then
                    s.Bitmap.UpdateLink
            End If
        Next s
    Next p
    
    Optimization = False
    Application.Refresh
    ActiveWindow.Refresh
End Sub

Hi Shelby,

This is good. Thanks for your work!

Speeds up process of making sure linked images on page resemble the real ones that will print, without having to go to the link docker at all.

I tried recording in Corelscript in Draw ver 9 to see if the refresh command would appear that way, but nope.

FYI, it's possible to use Photoshop files as linked documents. I prefer PP myself, but some like PS. They open in PS with the "open link with associated application" button in link docker.

But... the "open link with associated application" icon in link docker doesn't seem to have VBA command either. Only way to launch PS is through link docker, not a toolbar button or hotkey. Oh well.

Thanks Again,

Jeff

[wOxxOm]

activeshape.OLE.Edit - should invoke associated editor