Word a excel

Hola josaul75.
Tengo una consulta de como realizar una macro en word para que me lleve todos los títulos 1 y títulos 2 me los lleve en distintas celdas de excel (B15-C15), ambos títulos en diferente celdas insertándose hacia abajo correlativamente.
Si me puedes ayudar... Gracias.
Respuesta
1
Te dejo este código a ver si te sirve
Sub Macro1()
    Dim ExcelApp As Object
    Dim nParrafo As Integer
    Dim sParrafo As Paragraph
    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
    nParrafo = 15
    For Each sParrafo In ActiveDocument.Paragraphs
        If sParrafo.OutlineLevel = wdOutlineLevel1 Then
            ExcelApp.Range("B" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
        If sParrafo.OutlineLevel = wdOutlineLevel2 Then
            ExcelApp.Range("C" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
    Next
End Sub
Hola, gracias por el tiempo que me dedicas. Tu código me sirvió muy bien.
Ahora que tengo los 2 códigos que me creaste que fueron el (Insertar comentarios y Insertar los titulos1 y títulos 2) todos estos en una hoja excel.
Pero lo que quiero logra es ordena esto ya que el titulo1, titulo2 y los comentario se me desordena al momento de ejecutar la macro.
La idea es la siguiente:
Lo quiero es que me pegue en la hoja excel el titulo 1, titulo2 y lo comentarios que corresponde a ese titulo, y haci sucesivamente. Osea cada titulo2 este con todos sus comentarios que corresponda al momento de ejecutar la macro y enviarlo al excel.
Acá te adjunto los códigos que me enviaste..
Sub Macro1()
    Dim ExcelApp As Object
    Dim nComentario As Integer
    Dim sComentario As Comment
    Dim sRutaExcel As String
    Dim sCelda As String
    Dim nParrafo As Integer
    Dim sParrafo As Paragraph
    sRutaExcel = "C:\MiExcel.xls"
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = True
    ExcelApp.Workbooks.Open FileName:=sRutaExcel
    ExcelApp.Worksheets("Hoja1").Select
    nComentario = 15
    For Each sComentario In ActiveDocument.Comments
        ExcelApp.Range("E" & nComentario).Value = sComentario.Range.Text
        ExcelApp.Range("D" & nComentario).Value = sComentario.Index
        nComentario = nComentario + 1
    Next
    nParrafo = 15
    For Each sParrafo In ActiveDocument.Paragraphs
          If sParrafo.OutlineLevel = wdOutlineLevel1 Then
            ExcelApp.Range("B" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
        If sParrafo.OutlineLevel = wdOutlineLevel2 Then
            ExcelApp.Range("C" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
    Next
End Sub
' De esta maneta me funciona bien, pero me pega los titulos1 y titulos 2 desordenados con los comentarios, los titulos no queda con sus comentarios correspondientes
Si me pudieras ayudar
De antemano muchas gracias
Que te parece si me mandas una copia de tu documento para hacerte una MACRO de acuerdo a lo que necesitas, mi correo es [email protected]
Hola.
La verdad quiero ver si me puedes ayudar con una macro en word... lo que quiero realizar en esta macro es que me lleve los comentarios de word a excel, lo cual ya lo tengo hecho, pero en la descripción del comentario tengo palabras que están entre paréntesis "Eso también lo quiero llevar a una celda en excel", pero no se como seleccionar algo especifico. Por ejemplo:
Dentro del comentario tengo por ejemplo esto:
comentario [x]: bla la bla bla (bla bla) bla bla.
Ojala te sirva el ejemplo, eso es lo quiero llevar lo que esta entre paréntesis a una celda en excel, ya que el detalle y el numero del comentario ya se como llevarlo a excel en distintas celdas.
Gracias
Hice unos cambios para que veas como extraer parte del texto, espero te sea de utilidad
Sub Macro2()
    Dim ExcelApp As Object
    Dim nComentario As Integer
    Dim sComentario As Comment
    Dim sRutaExcel As String
    Dim sCelda As String
    Dim nParrafo As Integer
    Dim sParrafo As Paragraph
    Dim sTextoEspecial As String
    Dim nPosIni As Integer
    Dim nPosFin As Integer

    sRutaExcel = "C:\MiExcel.xls"
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = True
    ExcelApp.Workbooks.Open FileName:=sRutaExcel
    ExcelApp.Worksheets("Hoja1").Select
    nComentario = 15
    For Each sComentario In ActiveDocument.Comments
        nPosIni = InStr(1, sComentario.Range.Text, "(")
        nPosFin = InStr(1, sComentario.Range.Text, ")")
        If nPosIni > 0 And nPosFin Then
            sTextoEspecial = Mid(sComentario.Range.Text, nPosIni, nPosFin - nposni)
            ExcelApp.Range("M" & nComentario).Value = sTextoEspecial
        End If

        ExcelApp.Range("E" & nComentario).Value = sComentario.Range.Text
        ExcelApp.Range("D" & nComentario).Value = sComentario.Index
        nComentario = nComentario + 1
    Next
    nParrafo = 15
    For Each sParrafo In ActiveDocument.Paragraphs
          If sParrafo.OutlineLevel = wdOutlineLevel1 Then
            ExcelApp.Range("B" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
        If sParrafo.OutlineLevel = wdOutlineLevel2 Then
            ExcelApp.Range("C" & nParrafo).Value = Trim(Replace(Replace(sParrafo.Range.Text, Chr(13), ""), Chr(12), ""))
            nParrafo = nParrafo + 1
        End If
    Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas