1
« en: Martes 22 de Junio de 2010, 22:10 »
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