更新完整功能

base/Export_JPEG_Link.bas

@@ -1,4 +1,10 @@
+Private Sub cmd更新图片_Click()
+    UpdateLink_Bitmap
+End Sub
+
 Private Sub Export_JPEG_Link_Click()
+    Optimization = True
+
     ActiveDocument.Unit = cdrCentimeter
     Dim d As Document
     Set d = ActiveDocument
@@ -32,7 +38,58 @@ Private Sub Export_JPEG_Link_Click()
         Set impflt = ActiveLayer.ImportEx(f, cdrTIFF, impopt)
             impflt.Finish
             
+       ' 对齐原图，删除原图
+        ActiveSelection.AlignToShape cdrAlignHCenter + cdrAlignVCenter, sh
+        sh.Delete
+        UpdateLink_Bitmap
+        
         cnt = cnt + 1
     Next sh
- 
+    
+    Optimization = False
+    Application.Refresh
+    ActiveWindow.Refresh
+End Sub
+
+''''''''''  显示精度优化 ''''''''''''
+Private Function UpdateLink_Bitmap()
+
+    Dim OrigSel As ShapeRange
+
+    Set OrigSel = ActiveSelectionRange
+    ActiveDocument.ReferencePoint = cdrCenter
+    ' 放大200%
+    OrigSel.Stretch 2#, 2#
+
+    ' 更新链接图片
+    With ActiveShape.Bitmap
+    If .ExternallyLinked = True Then
+      .UpdateLink
+    End If
+    End With
+
+    ' 缩回原大(50%)
+    OrigSel.Stretch 0.5, 0.5
+End Function
+
+Private Sub FixOutdatedLinkedBitmaps_Click()
+    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