将不同的选定excel范围复制到不同的word文件中
问题描述:
我是vba的新手,我已经在网上搜索了一些关于我的问题的解决方案。 该项目是我有一个Excel工作表以不同的步骤配方列表看起来像这样:将不同的选定excel范围复制到不同的word文件中
RecipeName RecipeDescription Time Step StepDescription Results
Burger Bread + Meat Short Step1 Open Bread Bread open
Burger Bread + Meat Short Step2 Cook Meat Meat cooked
Soup Veggie Short Step1 Instant soup Soup done
我能够轻松地定义范围并将其粘贴到一个Word文档,但棘手的问题是这里:
我希望每个配方有一个word文档,首先包含配方名称,描述和时间标题,其中包含实际配方名称,描述和时间。然后将会跟随每个步骤编号,说明和结果。 所以它应该是这样的:
Burger
------
RecipeName RecipeDescription Time
Burger Bread + Meat Short
Step1 Open Bread Bread open
Step2 Cook Meat Meat cooked
Soup
----
RecipeName RecipeDescription Time
Soup Veggie Short
Step1 Instant soup Soup done
正如前面所说,我可以复制标题并将其粘贴到一个字,但难的是选择每个配方的步骤,并把它放入字然后保存字文件放入预定义的目录(保存部分已经完成并正在工作)。
我的想法是将配方名称作为一种排序方式,如果我们仍然处于相同配方或者我们跳到另一个配方。
功能上,它会是这样:
For i = 2 to lastRow
Open and activate a new word file
For j = 2 to lastRow
If Cells(j,1) = Cells(j+1; 1) Then
Copy Step, Step Description and Results of row(j)
Paste into word file
Next j
Else
Copy Step, Step Description and Results of row(i)
Paste into word file
Save the word file
i = j 'So i takes the value of j
Next i
但我有i和j之间的问题......
就目前我的代码看起来是这样,但请原谅我的它看起来业余:
Sub ExceltoWord()
' 'This part of the code will paste the information into word
Dim descriptionHeader As Range
Dim stepHeader As Range
Dim step As Range
Dim descriptionTest As Range
Dim lastRow As Integer
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
' this part of the code will call the rootfolder creation part
'Call NewFolder
' Will Set the title and descrption header
ThisWorkbook.Sheets("ToWord").Activate
Set descriptionHeader = Range("A1:C1")
Set stepHeader = Range("D1:F1")
'Have the last row stored for later
lastRow = WorksheetFunction.CountA(Range("A:A"))
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Create an Instance of MS Word
On Error Resume Next
'Is MS Word already opened?
Set WordApp = GetObject(class:="Word.Application")
'Clear the error between errors
Err.Clear
'If MS Word is not already open then open MS Word
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
'Handle if the Word Application is not found
If Err.Number = 429 Then
MsgBox "Microsoft Word could not be found, aborting."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Copy Excel Table Range Paste Table into MS Word
For i = 2 To lastRow
Set myDoc = WordApp.Documents.Add
descriptionHeader.Paste
'Need a part here to paste the actual recipe name, description and time
For j = 2 To lastRow
If Cells(i, 1).Content = Cells(i + 1, 1).Content Then
Cells(i, 6).Activate
ActiveCell.Offset(0, -2).Range("A1:C1").Select
With WordApp.Selection
.TypeText Text:=Cell.Text
.TypeParagraph
End With
Next j
Else
Cells(i, 6).Activate
ActiveCell.Offset(0, -2).Range("A1:C1").Select
With WordApp.Selection
.TypeText Text:=Cell.Text
.TypeParagraph
End With
Next i
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
现在已经几个星期,我粘在Excel中单词的一部分,因为我有巨大的diffic解决如何循环进入食谱并为每个食谱保存一个单词文件。
预先感谢您的帮助,
乔纳森
答
现在不能测试,但你的循环应该看起来有点像:
Dim RecipeName As String
Dim DocPath As String
Dim RecipeText As String
DocPath = "C:\.....\"
With ThisWorkbook.Sheets("ToWord")
For i = 2 To lastRow
If .Cells(i, 1).Value <> RecipeName Then 'New Recipe
If Not myDoc Is Nothing Then
myDoc.Range().Text = RecipeText
myDoc.SaveAs DocPath & RecipeName & ".doc"
myDoc.Close False
End If
RecipeName = .Cells(i, 1).Value
Set myDoc = WordApp.Documents.Add
RecipeText = .Cells(i, 1) & vbCrLf & "-----" & vbCrLf & .Cells(1, 1) & vbTab & .Cells(1, 2) & vbTab & .Cells(1, 3) & vbCrLf
RecipeText = RecipeText & .Cells(i, 1) & vbTab & .Cells(i, 2) & vbTab & .Cells(i, 3) & vbCrLf & vbCrLf
End If
RecipeText = RecipeText & .Cells(i, 4) & vbTab & .Cells(i, 5) & vbTab & .Cells(i, 6) & vbCrLf
Next i
myDoc.Range().Text = RecipeText
myDoc.SaveAs DocPath & RecipeName & ".doc"
myDoc.Close False
希望帮助
非常感谢您的回答我会尝试并给出结果更新 –
Jochen,非常感谢您。它像一个魅力。我不得不修改制表符和vbCrLf,以更好地布局Word文档,但除此之外它是完美的。当我试图说明自己的状况为.Cells(i,1)= .Cells(i + 1,1)时,简单的解决方案是让条件不同并存储要比较的值。非常简单,但在我看来,纯粹的天才。 –