[英]VBA copy and paste macro != manual copy paste
我試圖將excel中的表復制並粘貼到word文檔中。
我可以手動完成 - 突出顯示單元格,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
這是我的解決方案:
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
請為我嘗試這段代碼。 我用不同的表類型從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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.