InlineShapes 导出为图像添加边框答案

【问题标题】：InlineShapes exported as image add borderInlineShapes 导出为图像添加边框
【发布时间】：2021-12-30 02:48:34
【问题描述】：

使用以下代码保存 MS Word 图像并转换为 base64。

导出图像时，它会添加一些边框。
原图

导出后

If singleline.Range.InlineShapes.Count > 0 Then
    Dim shp1 As InlineShape
    Dim mchart1 As Shape
    Set shp1 = singleline.Range.InlineShapes(1)
    shp1.Select
    Selection.Copy
    Set mchart1 = ActiveDocument.Shapes.AddChart(xl3DAreaStacked, , , shp1.Width, shp1.Height)
    mchart1.Chart.ChartData.Workbook.Application.Quit
    mchart1.Chart.Paste
    mchart1.Chart.Export ("c:\here\" + CStr(i) + ".png")
    mchart1.Chart.Delete
    b64strng = ConvertFileToBase64("c:\here\" + CStr(i) + ".png")
    Kill "c:\here\" + CStr(i) + ".png"
End If

是否有任何修复或替代导出图像的方法？

【问题讨论】：

标签： vba ms-word

【解决方案1】：

我看不出您的屏幕截图有任何区别，可能是因为浏览器背景较暗。在 Export 命令之后，还是在 ConvertFileToBase64 函数之后，边框是否可见？

您似乎正在尝试使用图表组合导出非图表图形。通过使用 PowerPoint 进行图形导出，您将获得更好的结果。下面是一个示例宏，它展示了如何从 PowerPoint 中导出 Word 图形。您可以修改它以导出单个 Shape 或 ShapeRange（您的图形）而不是完整的幻灯片。

Public Sub ExportMap()
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShapeRange As PowerPoint.ShapeRange
Dim Path$, File$
Dim oRange As Range


  Application.ScreenUpdating = False
  If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
    ActiveDocument.Unprotect
  End If
  myDate$ = Format(Date, "m-d-yyyy")
  Set pptApp = CreateObject("PowerPoint.Application")
  Path$ = ActiveDocument.Path & Application.PathSeparator
  File$ = "WorldMap " & myDate$ & ".png"
  Set pptPres = pptApp.Presentations.Add(msoFalse)
  
  Set oRange = ActiveDocument.Bookmarks("WholeMap").Range
  oRange.CopyAsPicture
  
  Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
  On Error Resume Next
  With pptPres.PageSetup
    .SlideSize = 7
    .SlideWidth = 1150
    .SlideHeight = 590
  End With
  Set pptShapeRange = pptSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile, Link:=msoFalse)
  With pptShapeRange
    .Top = .Top + 6
'    .Left = .Left + 510
  End With
  
  pptSlide.Export Path$ & File$, "PNG"
  
  pptApp.Quit
  
  Set pptPres = Nothing
  Set pptApp = Nothing
  Set pptSlide = Nothing
  If ActiveDocument.ProtectionType = wdNoProtection Then
    ActiveDocument.Protect Type:=wdAllowOnlyFormFields, noreset:=True
  End If
  Application.ScreenUpdating = True
  MsgBox "All done! Check the folder containing this template for a file called '" & File$ & "'."
End Sub

【讨论】：