• Viernes 19 de Abril de 2024, 20:07

Autor Tema:  problemas con "InlineShapes"  (Leído 1984 veces)

oxikit

  • Nuevo Miembro
  • *
  • Mensajes: 1
    • Ver Perfil
problemas con "InlineShapes"
« en: Martes 22 de Junio de 2010, 22:10 »
0
Hola,


Tengo esta situación. Necesito bajar la información de varios formularios en word a una hoja de excel. En una pestaña estoy poniendo la lista de los doc's con todo y ruta, y en otra toda la información bajada. Funciona muy bien una vez, pero en la 2ª se atora invariablemente.
Abajo pongo el código, ya lo corrí como loop y sin loop, y en ambos casos me marca error en:

    For Each oShape In ActiveDocument.InlineShapes

Y no doy con el error. En realidad soy nuevo en VBA, así que puede ser que el error sea una cosa simple.
Gracias de antemano por la ayuda, saludos.

'Requiere reference: MSWord 11.0 Object Library
Sub ImportWordData()

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'     VAR'S
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Dim wdApp As Object
    Dim wd As Object
   
    Dim wordFilename As String
   
    Dim oShape As Word.InlineShape
    Dim r As Range
    Dim counter, i As Integer

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'     CODE
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
     'Gran Loop, un ciclo por .doc, se inicializa el contador
    i = 1
    Do While Not IsEmpty(Sheets("files2open").Cells(i, "A"))
         
         'Input
        wordFilename = Sheets("files2open").Cells(i, "A")
         
         'prepara wdApp
        On Error Resume Next
        Set wdApp = GetObject("Word.Application")
        If Err.Number <> 0 Then
            Set wdApp = CreateObject("Word.Application")
        End If
        On Error GoTo 0
         
         'Prepara el formulario en .doc para ser abierto
        Set wd = wdApp.Documents.Open(wordFilename)
        wdApp.Visible = False
       
         'Escoje el lugar desdd tempData para empezar a poner la info
        Sheets("tempData").Activate
        Cells(1, 1).Activate
        Do While Not IsEmpty(ActiveCell)
            ActiveCell.Offset(1, 0).Activate
        Loop
       
         'Pone el valor de OptionButton/CheckBox/Label en el siguiente renglón
        counter = 0
        For Each oShape In ActiveDocument.InlineShapes
            Select Case (oShape.OLEFormat.progID)
                Case "Forms.Label.1"
                            ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Caption
                            counter = counter + 1
                Case "Forms.OptionButton.1"
                            ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Value
                            counter = counter + 1
                Case "Forms.CheckBox.1"
                            ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Value
                            counter = counter + 1
            End Select
        Next oShape
             
        wd.Close: Set wd = Nothing
        wdApp.Quit: Set wdApp = Nothing

   
    i = i + 1
     'Final del gran Loop
    Loop
0:
End Sub