Microsoft Excel將單元格複製到Word中

Question

這是我的第一篇文章，請裸露在我身邊。這是我第一次使用VBA進行編程，我需要一些幫助！我搜查了以前的線程，並沒有找到我正在嘗試做的事情。

我試圖將excel單元格複製到word文檔 - 只是內容而不是格式。例如，我想複製這些單元格：A5（這是一個日期格式）作爲第一行，後面一行中的單元格（E5，K5，L5）和單元格（N5，P5，T5，U5）作爲最後一行在詞中。我想爲下一行直到最後一行數據可用。

例如，在Word中，我想從Excel單元格在這個格式的內容：

A5 
E5 K5 L5 
N5 P5 T5 U5 

A6 
E6 K6 L6 
N6 P6 T6 U6 

[...] 

更新：

我已經能夠從Excel到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 

'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 

「Base + lenOfDate + 1」是爲了解釋索引錯誤。 （14 *（lRow - 4））沒有任何邏輯意義，我添加它來補償這個事實，即我想更改單元格之後的字符正在被修改。

更新2：

所以我決定不採取這種方法從更新1.相反，我嘗試不同的方法，但它拋出回的錯誤：「對象不支持此屬性或方法「爲」selStart = Selection.Start「。

編號：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

OK，我發現了這個有趣的，所以我繼續在它的工作。我通常不會在Word中使用VBA，所以它可能非常原始，但它是您開始的地方。請記住，您必須將Word添加到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