VBA複製和粘貼宏！=手動複製粘貼

我試圖從excel中複製和粘貼表格到word文檔中。VBA複製和粘貼宏！=手動複製粘貼

我可以手動做 - 突出顯示單元格，CTRL + C，轉到單詞CTRL + V.它工作正常。

但是，當我寫一個宏來做它的單元格的高度是兩倍，就像每個單元格中的行高因某些原因而發生更改。爲什麼它不同？我記錄了手動過程，並調用了相同的函數（PasteExcelTable）。

Set wordDoc = wordApp.Documents.Open(wordDocPath) 

With wordDoc 
    ' cost report 
    Dim wordRng As Word.Range 
    Dim xlRng As Excel.Range 
    Dim sheet As Worksheet 
    Dim i As Integer 
    Dim r As String 

    'Copy the cost report from excel sheet 
    Set sheet = ActiveWorkbook.Sheets("COST REPORT") 
    i = sheet.Range("A:A").Find("TOTAL PROJECT COST", Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).row 
    r = "A11:M" + Trim(Str(i)) 

    Set xlRng = sheet.Range(r) 
    xlRng.Copy 

    'Copy and Paste Cost report from Excel 
    Set wordRng = .Bookmarks("CostReport").Range 'remember original range 

    If .Bookmarks("CostReport").Range.Information(wdWithInTable) Then 
     .Bookmarks("CostReport").Range.Tables(1).Delete 
    End If 

    .Bookmarks("CostReport").Range.PasteExcelTable False, False, False 
    .Bookmarks.Add "CostReport", wordRng 'reset range to its original positions 
End With

來源

2011-12-11 mobiletim

你可能[查看文檔（HTTP：// MSDN .microsoft.com/en-us/library/aa202201％28v = office.10％29.aspx）並嘗試使用'true'作爲最後兩個參數之一，看看是否可以修復它。 –

如果我將最後一個設置爲true（RTF），它看起來不同，但看起來不像CTRL + V.但是通過在將代碼粘貼爲HTML之後更新代碼中的格式，我變得非常接近。 – mobiletim

這裏是我的解決方案：

With wordDoc 
    'Paste table from Excel 
    Set wordRng = .Bookmarks(bookMarkName).range 'remember original range 

    If .Bookmarks(bookMarkName).range.Information(wdWithInTable) Then 
     .Bookmarks(bookMarkName).range.Tables(1).Delete 
    End If 

    .Bookmarks(bookMarkName).range.PasteExcelTable False, False, False 
    .Bookmarks.Add bookMarkName, wordRng 'reset range to its original positions 

    Dim paraFmt As ParagraphFormat 
    Set paraFmt = .Bookmarks(bookMarkName).range.Tables(1).range.ParagraphFormat 

    paraFmt.SpaceBefore = 0 
    paraFmt.SpaceBeforeAuto = False 
    paraFmt.SpaceAfter = 0 
    paraFmt.SpaceAfterAuto = False 
    paraFmt.LineSpacingRule = wdLineSpaceSingle 
    paraFmt.WidowControl = True 
    paraFmt.KeepWithNext = False 
    paraFmt.KeepTogether = False 
    paraFmt.PageBreakBefore = False 
    paraFmt.NoLineNumber = False 
    paraFmt.Hyphenation = True 
    paraFmt.OutlineLevel = wdOutlineLevelBodyText 
    paraFmt.CharacterUnitLeftIndent = 0 
    paraFmt.CharacterUnitRightIndent = 0 
    paraFmt.CharacterUnitFirstLineIndent = 0 
    paraFmt.LineUnitBefore = 0 
    paraFmt.LineUnitAfter = 0 
    paraFmt.MirrorIndents = False 
    paraFmt.TextboxTightWrap = wdTightNone 
    paraFmt.Alignment = wdAlignParagraphLeft 

    .Bookmarks(bookMarkName).range.Tables(1).AutoFitBehavior (wdAutoFitWindow) 

End With

來源

2012-01-17 00:13:30 mobiletim

請嘗試這個樣本代碼段請給我。我測試了它從不同的表類型的VBA Excel，它給了我滿意的結果。請修改它徘徊無論需要...例如文件名/表名等等

Sub Sample() 
    Dim oWordApp As Object, oWordDoc As Object 
    Dim FlName As String 

    FlName = "C:\MyDoc.doc" 

    '~~> Establish an Word application object 
    On Error Resume Next 
    Set oWordApp = GetObject(, "Word.Application") 

    If Err.Number <> 0 Then 
     Set oWordApp = CreateObject("Word.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    oWordApp.Visible = True 

    Set oWordDoc = oWordApp.Documents.Open(FlName) 

    With oWordDoc 
     Dim xlRng As Range 

     Set xlRng = Sheets(1).Range("A1:D10") 
     xlRng.Copy 

     .Bookmarks("CostReport").Range.PasteSpecial Link:=False, _ 
     Placement:=wdInLine, DisplayAsIcon:=False 
    End With 
End Sub

來源

2012-01-11 19:11:14

nope，表格仍然粘貼在雙單元格高度，我只能通過在宏中手動重新格式化來解決此問題 – mobiletim

請嘗試此操作。在Excel中自動調整行和列，然後再試一次:)您必須先增加列和行，然後執行Autofit。等待聽到你的消息...... –

我嘗試了autofit窗口，自動適應內容，沒有改變。這是因爲每個單元格的段落大小。段落設置「間距」在前後設置爲6pt，倍數爲1.15。它應該是0/0，單個 – mobiletim

VBA複製和粘貼宏！=手動複製粘貼

回答

相關問題