You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Excel含图片区域复制到Word书签后单元格拆分问题及解决

解决Excel带图片区域复制到Word后单元格拆分问题

当使用VBA将包含图片的Excel区域复制粘贴到Word书签位置时,Word表格中图片旁的单元格会出现拆分异常。经排查,确认问题由嵌入的图片导致——移除图片后,表格可正常插入到Word中。

通过为Excel中的图片设置名称,单独将图片复制并粘贴到Word表格的指定单元格,可解决该问题。修改后的完整VBA代码如下:

Sub Export2Doc()

    Const stWordDocument As String = "Test_Word.docx"
    
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    
    Dim wbBook As Workbook
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set wbBook = ThisWorkbook
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
    
    With wdDoc

        .Bookmarks("Manufacturer").Range = Form.Range("E8").Value
        .Bookmarks("Material").Range = Form.Range("E9").Value

        Form.Range("D25:J62").Copy
        .Bookmarks("Form_1").Range.PasteExcelTable False, False, False
        With .Tables(1)
            .Range.ParagraphFormat.SpaceAfter = 0
            .Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
            .AutoFitBehavior (wdAutoFitWindow)
            .AllowAutoFit = True
            '---------------------------------------------------------------------------------------------------
            '新增代码:将图片作为形状复制到Word表格指定单元格
            Form.Shapes("STRCrown").Copy
            With .Cells(4, 1)
               .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
               .VerticalAlignment = wdCellAlignVerticalCenter
               .Range.PasteAndFormat wdFormatOriginalFormatting
            End With
            '新增代码结束
            '---------------------
        End With
        
        .TablesOfContents(1).Update

        .SaveAs2 wbBook.Path & "\\MaterialAccess_" & Form.Range("E9") & "_" & Format(Now, "yyyy-mm-dd_hhmm") & ".docx"

        .ExportAsFixedFormat wbBook.Path & "\MaterialAccess_" & Form.Range("E9") & "_" & Format(Now, "yyyy-mm-dd_hhmm") & ".pdf", wdExportFormatPDF
        
        .Save
        .Close SaveChanges:=False
    End With
    
    wdApp.Quit
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    MsgBox "Document created", vbInformation
    
EndRoutine:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.CutCopyMode = False

End Sub

内容的提问来源于stack exchange,提问作者Dennis

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.13 19:58:30