Question

我试图将excel单元格复制到word文档中 - 只是内容而不是格式。例如，我想复制这些单元格：A5（这是一种日期格式）作为第一行，单元格中的单元格（E5，K5，L5）和单元格（N5，P5，T5，U5）作为最后一行在单词中。我想对下一行直到数据可用的最后一行做同样的事情。

例如，单词中，我想要这种格式的excel单元格中的内容：

A5
E5 K5 L5
N5 P5 T5 U5

A6
E6 K6 L6
N6 P6 T6 U6

[...]

更新

我已经能够将所有内容从excel拉到另一个单词。但是，需要为特定单元格更改字体。我正在解析以找到单元格的长度并修改该部分以更改为不同的文本，但它不起作用，而且我完全丢失了。

Sub Convert_to_Word()

Dim rng As Range
Dim sh As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim Wordrng As Word.Range
Dim lRow As Long

'WordDoc.Content.Style = ("No Spacing")

Set sh = ActiveSheet

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
Set Wordrng = WordDoc.Range(Start:=0)

' Find Last Row of Data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

' Needed to establish wordrng in doc
Wordrng.InsertBefore ("")

Base = 0
c = 0

' After each insertion, Wordrng includes the new text
' Copying Content Over
For lRow = 5 To FinalRow

    lenOfE = Len(sh.Range("E" & lRow))
    lenOfDate = Len(sh.Range("A" & lRow))

    Wordrng.InsertAfter (sh.Range("A" & lRow)) & vbCrLf

    Wordrng.InsertAfter (sh.Range("E" & lRow)) & " "

    Set WordrngofE = WordDoc.Range(Start:=Base + lenOfDate + 1, End:=Base + lenOfDate + 1 + lenOfE)
    WordrngofE.Font.Name = "Calibri"

    Wordrng.InsertAfter (sh.Range("K" & lRow)) & " "
    Wordrng.InsertAfter (sh.Range("L" & lRow)) & vbCrLf

    Wordrng.InsertAfter (sh.Range("N" & lRow)) & " "
    Wordrng.InsertAfter (sh.Range("P" & lRow)) & " "
    Wordrng.InsertAfter (sh.Range("T" & lRow)) & " "
    Wordrng.InsertAfter (sh.Range("U" & lRow)) & " "
    Wordrng.InsertAfter (sh.Range("V" & lRow)) & vbCrLf

    c = c + lenOfDate
    Base = WordDoc.Range.ComputeStatistics(wdStatisticCharacters) + (14 * (lRow - 4)) + c '+ (lenOfDate * (lRow - 4))

Next lRow

End Sub

＆＃34; Base + lenOfDate + 1＆＃34;是为了解决索引错误。（14 *（lRow - 4））没有任何逻辑意义，我补充说它是为了补偿我想改变的单元格之后的字符被修改的事实。

更新2：

所以我决定不采用Update 1的方法。相反，我尝试了一种不同的方法，但它却抛出了一个错误：＆＃34;对象不支持这个属性或方法＆＃34 ＃34; for＆＃34; selStart = Selection.Start＆＃34;。

参考：Excel VBA: setting font style and size while adding text to MS-Word

Sub Convert_to_Word()

Dim rng As Range
Dim sh As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim Wordrng As Word.Range
Dim lRow As Long

Dim selStart As Long

Set sh = ActiveSheet
Set WordApp = CreateObject("Word.Application")

WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
Set Wordrng = WordDoc.Range(Start:=0)

' Find Last Row of Data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

' Establish WordRng in Doc
Wordrng.InsertBefore ("")

    'Wordrng.Font.Name = "Arial"
    'Wordrng.Font.Size = 7
    'Wordrng.Font.ColorIndex = wdBlack

    ' After each insertion, Wordrng includes the new text
    ' Copying Content Over
    For lRow = 5 To FinalRow

        lenOfE = Len(sh.Range("E" & lRow))
        lenOfDate = Len(sh.Range("A" & lRow))
        selStart = Selection.Start

        Wordrng.InsertAfter (sh.Range("A" & lRow)) & vbCrLf

        'Wordrng.InsertAfter (sh.Range("E" & lRow)) & " "

        WordDoc.Range(selStart).InsertAfter (sh.Range("E" & lRow)) & " "
        With WordDoc.Range(selStart, selStart + lenOfE)
            .Font.Name = "Times New Roman"
            .Font.Size = 15
        End With

        ' TRIAL
        '--- Remove selection. This will move the cursor at end of selected word
        'Selection.MoveRight Unit:=wdCharacter, Count:=1

        '--- Select the inserted word
        'Selection.MoveRight Unit:=wdCharacter, Count:=Len(sh.Range("E" & lRow)), Extend:=wdExtend
        'Selection.Font.Name = "Calibri"
        'Selection.Font.Size = 7

        Wordrng.InsertAfter (sh.Range("K" & lRow)) & " "
        Wordrng.InsertAfter (sh.Range("L" & lRow)) & " "
        Wordrng.InsertAfter (sh.Range("V" & lRow)) & vbCrLf

    Next lRow

WordApp.Quit

End Sub

Answer 1

好的，我发现这很有趣，所以我继续努力。我通常不会在Word中使用VBA，所以它可能非常原始，但它是你开始的地方。请记住，您必须在Excel VB编辑器中将引脚添加到引用中。

Option Explicit
Sub Make_Word_Doc()
Dim rng As Range
Dim sh As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim Wordrng As Word.Range

Set sh = ActiveSheet

Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
Set Wordrng = WordDoc.Range(Start:=0)

Wordrng.InsertBefore ("") 'seems to be needed to establish wordrng in the document.
'after each insertion, Wordrng includes the new text

'work on these commands to place the text where you want it.
Wordrng.InsertAfter (sh.Range("A5")) & vbCrLf
Wordrng.InsertAfter (sh.Range("E5")) & " "
Wordrng.InsertAfter (sh.Range("K5")) & "  "
Wordrng.InsertAfter (sh.Range("L5")) & vbCrLf
Wordrng.InsertAfter (sh.Range("N5")) & vbTab
Wordrng.InsertAfter (sh.Range("P5")) & vbTab
Wordrng.InsertAfter (sh.Range("T5")) & vbTab
Wordrng.InsertAfter (sh.Range("U5")) & vbCrLf

Stop 'take this out when you're done playing around

WordDoc.Close False ' this will close the file without saveing.  handy for testing
WordApp.Quit

End Sub

Microsoft Excel将单元格复制到Word

1 个答案: