Word... Pasar los comentarios a Excel
Hola a todos.
La pregunta es la siguiente, quiero hacer una macro en Word 2003, en la cual solo los comentarios de Word los quiero insertar en Excel, en distintas celdas, por ejemplo el, numero del comentario insértalo en la celda D15 hacia abajo correlativamente, y el detalle del comentario insertarlo en la celda E15 correlativamente, además cada titulo y subtitulo de Word insértalo en cada una en diferentes celdas (B15 - C15), en correlativo. Si se puede realizar esto, por favor necesito ayuda, no se como hacerlo, ya que no hay información de lo que quiero realizar. Gracias
La pregunta es la siguiente, quiero hacer una macro en Word 2003, en la cual solo los comentarios de Word los quiero insertar en Excel, en distintas celdas, por ejemplo el, numero del comentario insértalo en la celda D15 hacia abajo correlativamente, y el detalle del comentario insertarlo en la celda E15 correlativamente, además cada titulo y subtitulo de Word insértalo en cada una en diferentes celdas (B15 - C15), en correlativo. Si se puede realizar esto, por favor necesito ayuda, no se como hacerlo, ya que no hay información de lo que quiero realizar. Gracias
1 Respuesta
Respuesta de José Saúl Méndez Alonso
1
Te dejo este código a ver si te sirve
Sub Macro1()
Dim ExcelApp As Object
Dim nComentario As Integer
Dim sComentario As Comment
Dim sRutaExcel As String
Dim sCelda As String
sRutaExcel = "C:\MiExcel.xls"
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
' Estas líneas son opcionales solo por si quieres que se cree el archivo
' ExcelApp.Workbooks.Add
' ExcelApp.ActiveWorkbook.SaveAs FileName:="C:\MiExcel.xls", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ExcelApp.Workbooks.Open FileName:=sRutaExcel
ExcelApp.Worksheets("Hoja1").Select
nComentario = 15
For Each sComentario In ActiveDocument.Comments
If sComentario.Scope.ParagraphFormat.OutlineLevel = wdOutlineLevel1 Then
ExcelApp.Range("B" & nComentario).Value = sComentario.Scope.Text
End If
If sComentario.Scope.ParagraphFormat.OutlineLevel = wdOutlineLevel2 Then
ExcelApp.Range("C" & nComentario).Value = sComentario.Scope.Text
End If
ExcelApp.Range("E" & nComentario).Value = sComentario.Range.Text
ExcelApp.Range("D" & nComentario).Value = sComentario.Index
nComentario = nComentario + 1
Next
End Sub
Sub Macro1()
Dim ExcelApp As Object
Dim nComentario As Integer
Dim sComentario As Comment
Dim sRutaExcel As String
Dim sCelda As String
sRutaExcel = "C:\MiExcel.xls"
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
' Estas líneas son opcionales solo por si quieres que se cree el archivo
' ExcelApp.Workbooks.Add
' ExcelApp.ActiveWorkbook.SaveAs FileName:="C:\MiExcel.xls", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ExcelApp.Workbooks.Open FileName:=sRutaExcel
ExcelApp.Worksheets("Hoja1").Select
nComentario = 15
For Each sComentario In ActiveDocument.Comments
If sComentario.Scope.ParagraphFormat.OutlineLevel = wdOutlineLevel1 Then
ExcelApp.Range("B" & nComentario).Value = sComentario.Scope.Text
End If
If sComentario.Scope.ParagraphFormat.OutlineLevel = wdOutlineLevel2 Then
ExcelApp.Range("C" & nComentario).Value = sComentario.Scope.Text
End If
ExcelApp.Range("E" & nComentario).Value = sComentario.Range.Text
ExcelApp.Range("D" & nComentario).Value = sComentario.Index
nComentario = nComentario + 1
Next
End Sub
Muchas gracias por la respuesta y por el interés...
lo voy a ejecutar y te cuento...
Saludos
lo voy a ejecutar y te cuento...
Saludos
Muy bien si requieres algo más no dudes en hacérmelo saber.
