Question

我是vba的新手，我现在已经在互联网上搜索了多年来解决我的问题。该项目是我在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

我可以轻松地定义一个范围并将其粘贴到一个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之间有问题...

目前我的代码看起来像这样，但请原谅我的业余外观：

    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上，因为我在解决如何循环进入食谱并为每个食谱保存一个word文件时遇到了巨大的困难。

先谢谢你的帮助，

乔纳森

Answer 1

现在无法测试，但你的循环应该看起来像那样：

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

希望有所帮助

将不同的选定Excel范围复制到不同的单词文件中

1 个答案: