VBA скопируйте и вставьте макрос! = Вставьте вручную копировать - PullRequest
Новая
       31

VBA скопируйте и вставьте макрос! = Вставьте вручную копировать

0 голосов
/ 12 декабря 2011

Я пытаюсь скопировать и вставить таблицу из Excel в текстовый документ.

Я могу сделать это вручную - выделите ячейку, 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

Ответы [ 2 ]

2 голосов
/ 17 января 2012

Вот мое решение: 

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
0 голосов
/ 11 января 2012

Попробуйте этот образец кода для меня, пожалуйста.Я протестировал его в 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
...