Pass each of the rows from Excel to Word rtf in paragraphs in established order

Visor · #1 06-29-2020, 07:59 PM

Dear forum members. Regards
I have tried to ensure that when I use the macro in Excel, a Word .rtf document is filled with the disposition of the paragraphs as you can see in the file that I upload. First of all, i can't get all the rows to be passed in excel only the last one is passed. Also I cannot send the numbers (num and pts) I get error A8 .... and J8 ...

I request you can collaborate with me on this topic
My Excel is 2013
I upload the file for you to see
I thank you in advance for your support

Guessed · #2 06-29-2020, 08:42 PM

Firstly when you declare variables you should explicitly define each variable's type
Dim pregunta, opA, opB, opC, opD, ans, respC, explRC, dif, ref, obj, topic, pclave, prof As String
In the above declaration, only prof is a string. All the other variables are variants. It needs to be written as
Dim pregunta as String, opA as String, opB as String

Secondly, your code creates a document and then start looping through the rows and before you move to the next row, you close the document. This means on the second pass of the loop, the document is no longer open.

Did you want one document per row or are you creating a single document containing all the row content?

Visor · #3 06-29-2020, 11:01 PM

Truly very grateful. It is true!! I have removed 'objselection.Close savechanges: = True and now I have all the rows in one word document, which is how I need.

Now .TypeText num and .TypeText pts which is the numerical order of column A (from A8 ...) and Column J (from J8 ..) 3 points for each row

I have now declared these num and pts variables as a variant, ... but it still gives me an error

How should I declare them so that I don't get an error?

gmayor · #4 06-29-2020, 11:33 PM

You have some strange syntax in your workbook. May I suggest that you try the following instead:

Code:

Sub ExWordPruebam2()
Dim wordapp As Object
Dim fs As Object
Dim documento As Object
Dim objselection As Object
Dim fila, i As Integer
Dim wdApp As Object

Dim tema As String
Dim nomprof As String
Dim camino As String

Dim num, pts As Integer

Dim pregunta, opA, opB, opC, opD, ans, respC, explRC, dif, ref, obj, topic, pclave, prof As String

    Set wordapp = CreateObject("Word.Application")
    wordapp.Visible = True
    'Set fs = CreateObject("Scripting.FileSystemObject")

    Set documento = wordapp.Documents.Add
    Set objselection = documento.Range

    tema = ThisWorkbook.Worksheets(1).Cells(1, 2).Value
    objselection.Text = tema & vbCr

    nomprof = ThisWorkbook.Worksheets(1).Cells(6, 2).Value
    objselection.Collapse 0
    objselection.Text = nomprof & vbCr

    Range("A8").Select
    fila = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 8 To fila

        num = ThisWorkbook.Worksheets(1).Cells(i, 1).Value
        pregunta = ThisWorkbook.Worksheets(1).Cells(i, 2).Value
        opA = ThisWorkbook.Worksheets(1).Cells(i, 3).Value
        opB = ThisWorkbook.Worksheets(1).Cells(i, 4).Value
        opC = ThisWorkbook.Worksheets(1).Cells(i, 5).Value
        opD = ThisWorkbook.Worksheets(1).Cells(i, 6).Value
        ans = ThisWorkbook.Worksheets(1).Cells(i, 7).Value
        respC = ThisWorkbook.Worksheets(1).Cells(i, 8).Value
        explRC = ThisWorkbook.Worksheets(1).Cells(i, 9).Value
        pts = ThisWorkbook.Worksheets(1).Cells(i, 10).Value
        dif = ThisWorkbook.Worksheets(1).Cells(i, 11).Value
        ref = ThisWorkbook.Worksheets(1).Cells(i, 12).Value
        obj = ThisWorkbook.Worksheets(1).Cells(i, 13).Value
        topic = ThisWorkbook.Worksheets(1).Cells(i, 14).Value
        pclave = ThisWorkbook.Worksheets(1).Cells(i, 15).Value
        prof = ThisWorkbook.Worksheets(1).Cells(i, 16).Value

        'objselection.Font.Bold = True
        With objselection
            .Collapse 0
            'A8...
            .Text = num & vbCr

            .Collapse 0
            .Text = pregunta & vbCr

            .Collapse 0
            .Text = "a. " & opA & vbCr

            .Collapse 0
            .Text = "b. " & opB & vbCr

            .Collapse 0
            .Text = "c. " & opC & vbCr

            .Collapse 0
            .Text = "d. " & opD & vbCr

            .Collapse 0
            .Text = "ANS: " & ans & vbCr

            .Collapse 0
            .Text = "Repuesta correcta " & vbCr & respC & vbCr

            .Collapse 0
            .Text = "Explicación de la respuesta " & vbCr & explRC & vbCr

            'J8....
            .Collapse 0
            .Text = "PTS: " & pts & vbCr

            .Collapse 0
            .Text = "DIF: " & dif & vbCr

            .Collapse 0
            .Text = "REF: " & ref & vbCr

            .Collapse 0
            .Text = "OBJ: " & obj & vbCr

            .Collapse 0
            .Text = "TOP: " & topic & vbCr

            .Collapse 0
            .Text = "KEY: " & pclave & vbCr

            .Collapse 0
            .Text = "NOT: " & prof & vbCr
        End With


        With wordapp.ActiveDocument
            camino = ThisWorkbook.Path & "\" & nomprof

            .SaveAs Filename:=camino & ".rtf"

            .Close savechanges:=True
        End With
    Next i

    wordapp.Application.Quit
    'Set fs = Nothing
    Set objselection = Nothing
    Set documento = Nothing
    Set wordapp = Nothing
End Sub

Guessed · #5 06-30-2020, 12:30 AM

I don't see the problem with the data you posted but I did fix some of your code declarations and streamlined it which may have resolved the issue. Try this code with your real data and see if you still have the problem.

Code:

Sub ExWordPruebam2()
  Dim wordapp As Object, objWord As Object
  Dim fs As Object, documento As Object
  Dim objselection As Object
  Dim fila As Integer, i As Integer
  Dim tema As String, nomprof As String, camino As String
  Dim num As Integer, pts As Integer
  Dim pregunta As String, opA As String, opB As String, opC As String, opD As String
  Dim ans As String, respC As String, explRC As String, dif As String, ref As String
  Dim obj As String, topic As String, pclave As String, prof As String

  Set wordapp = CreateObject("Word.Application")
  Set fs = CreateObject("Scripting.FileSystemObject")
  
  Set documento = wordapp.Documents.Add
  Set objselection = wordapp.Selection
  
  tema = ActiveSheet.Cells(1, 2).Value
  objselection.TypeText tema & vbCr
  
  nomprof = ActiveSheet.Cells(6, 2).Value
  objselection.TypeText nomprof & vbCr
  
  Range("A8").Select
  fila = Cells(Rows.Count, 1).End(xlUp).Row
  wordapp.Visible = True
  
  For i = 8 To fila
    With ActiveSheet
      num = .Cells(i, 1).Value
      pregunta = .Cells(i, 2).Value
      opA = .Cells(i, 3).Value
      opB = .Cells(i, 4).Value
      opC = .Cells(i, 5).Value
      opD = .Cells(i, 6).Value
      ans = .Cells(i, 7).Value
      respC = .Cells(i, 8).Value
      explRC = .Cells(i, 9).Value
      pts = .Cells(i, 10).Value
      dif = .Cells(i, 11).Value
      ref = .Cells(i, 12).Value
      obj = .Cells(i, 13).Value
      topic = .Cells(i, 14).Value
      pclave = .Cells(i, 15).Value
      prof = .Cells(i, 16).Value
    End With
  
    With objselection
      .TypeText num & vbCr
      .TypeText pregunta & vbCr
      .TypeText "a. " & opA & vbCr
      .TypeText "b. " & opB & vbCr
      .TypeText "c. " & opC & vbCr
      .TypeText "d. " & opD & vbCr
      .TypeText "ANS: " & ans & vbCr
      
      .TypeText "Repuesta correcta " & vbCr
      .TypeText respC & vbCr
      .TypeText "Explicación de la respuesta " & vbCr
      .TypeText explRC & vbCr
      
      .TypeText "PTS: " & pts & vbCr
      .TypeText "DIF: " & dif & vbCr
      .TypeText "REF: " & ref & vbCr
      .TypeText "OBJ: " & obj & vbCr
      .TypeText "TOP: " & topic & vbCr
      .TypeText "KEY: " & pclave & vbCr
      .TypeText "NOT: " & prof
    End With
  Next i
  
  With wordapp.ActiveDocument
    camino = ThisWorkbook.Path & "\" & nomprof
    .SaveAs Filename:=camino & ".rtf"
    .Close savechanges:=True
  End With
  wordapp.Application.Quit
  Set fs = Nothing
  Set objselection = Nothing
  Set documento = Nothing
  Set wordapp = Nothing
End Sub

Visor · #6 06-30-2020, 02:19 AM

regards
I have been reviewing, slowly and have noticed the following:
The .TypeText code has a lot to do with the encoding. The variables have to be declared as explained by Guessed, otherwise it is a reason for error.
In addition, with .TypeText the response speed is immediate, not so, with the gmayor code, with which the result is obtained well, however it takes too long. The comparison was made by making adjustments to both codes because the Guessed code did not number each question. While in the gmayor code I had to get --- (With wordapp.ActiveDocument path = ThisWorkbook.Path & "" & nomprof .SaveAs Filename: = path & ".rtf" .Close savechanges: = True ") outside the for - next because I want everything in a single document. Equalizing everything I see that .TypeTex allows a much faster result.

I am very grateful to both for the resolution of this topic, I have learned a lot

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
reverse order of paragraphs, word 2010	moorea21	Word VBA	1	08-02-2018 03:47 AM
automatic insert hypens until the end of the row and in empty rows between paragraphs	Ivica	Word	3	12-28-2015 01:31 PM
Selecting values from different rows in a table and sort them in order in a single row	FromF	Excel	2	09-09-2014 02:30 AM
Office 2010 Excel Full pass	raineraus	Excel	1	09-19-2012 12:55 PM
Word Merge from Excel not in same order!	Coreysan	Mail Merge	3	12-11-2011 04:22 PM