将不同的选定excel范围复制到不同的单词文件中
我是新来的vba，我已经在互联网上search了很长时间了解我的问题。 该项目是我在一个Excel工作表上有一个不同步骤的食谱列表，如下所示：
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 我很容易定义一个范围并将其粘贴到一个单词文档中，但棘手的部分在这里：
我想每个食谱有一个单词文档，首先包含食谱名称，描述和时间标题，其中包含实际食谱名称，描述和时间。 接下来是每个步骤的编号，描述和结果。 所以它看起来像这样：
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
如前所述，我可以复制标题并将其粘贴到一个单词中，但难点在于select每个食谱的步骤并将其放入单词中，然后将单词文件保存到预定义的目录中（保存部分已经完成并正在工作）。
我的想法是把食谱的名字作为一种方法来分类，如果我们仍然在相同的食谱，或者如果我们跳到另一个。
在function上，它会是这样的：
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
但我有问题，我和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的文字部分，因为我有很大的困难，要清理如何循环到食谱中，并为每个文件保存一个单词文件。
在此先感谢您的帮助，
乔纳森
现在不能testing，但是你的循环应该看起来像这样：
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
希望有所帮助