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