Worksheets.shapes(i) no lo reconoce como shape en word

AlejandroArroz · el 15 de enero

(Ante todo perdon por la ausencia de tildes pues estoy usando un teclado extrangero )

Hola a todos. Tengo el siguiente problema:

Resulta que tengo que hacer una macro que, en Word, busque las imagenes de un archivo Excel para importarlas a este. Como no tenia ni idea de como hacerlo, busque un pequenho ejemplo que recorre las distintas imagenes en la hoja excel. Asi pues, tengo el siguiente codigo:



  Dim ExcelApplication As Excel.Application

  Dim ExcelWorkbook As Workbook

  Dim ExcelWorksheet As Excel.Worksheet


  Dim img As Shape

  Dim chrt As ChartObject

  Dim Nombreimg As String



  Dim i As Integer


  Set ExcelApplication = New Excel.Application

  Set ExcelWorkbook = ExcelApplication.Workbooks.Add(DocumentPath & OriginWorkbookName)

  Set ExcelWorksheet = ExcelWorkbook.Sheets(1)


  For i = 0 To (ExcelWorksheet.Shapes.Count - 1)


  Set img = ExcelWorksheet.Shapes(i)


  Next[/CODE]

Sin embargo, me arroja un error en tiempo de ejecucion 13 en la linea marcada en negrita (los tipos no coinciden) como si ExcelWorksheet.Shapes(i) no fuese un Shape.

Lo gracioso de todo es que este mismo codigo en [b]Excel [/b]si me funciona:

[CODE]
Dim Worksheet As Worksheet
Dim img As Shape

Set Worksheet = ThisWorkbook.Worksheets(1)

For Each img In Worksheet.Shapes
MsgBox (img.Name)
Next
[/CODE]

Vamos, que no me arroja ningun error y el "For each" es capaz de recorrer cada uno de los Shapes y asignarselos a img sin problema.

La verdad es que estoy algo confundido... alguien puede saber que pasa?

Un saludo

logroastur · el 15 de enero

Buenas utiliza

    Sub ImportaShapes()
        Dim ExcelApplication    As Object 'Excel.Application
        Dim ExcelWorkbook       As Object 'Workbook
        Dim ExcelWorksheet      As Object 'Excel.Worksheet
        Dim img                 As Object 'Shape
        Dim chrt                As Object ' ChartObject
        Dim Nombreimg           As String
        Dim NombreExcel         As String
        Dim i                   As Integer
        Dim abierto             As Boolean
        On Error Resume Next
        NombreExcel = ArchivoExcel
        If NombreExcel = "@" Then
            MsgBox "No se realizo selección de archivo", vbCritical, ""
            Exit Sub
        End If
        Set ExcelApplication = GetObject(, "Excel.Application")
        If Err.Number = 0 Then
            With ExcelApplication
                For i = 1 To .Workbooks.Count
                    If .Workbooks(i).FullName = NombreExcel Then
                        abierto = True
                        Set ExcelWorkbook = .Workbooks(i)
                        Exit For
                    End If
                Next i
            End With
        Else
            Set ExcelApplication = CreateObject("Excel.Application")
            Err.Clear
        End If
        If ExcelWorkbook Is Nothing Then
            Set ExcelWorkbook = ExcelApplication.Workbooks.Open(NombreExcel)
        End If
        Set ExcelWorksheet = ExcelWorkbook.Sheets(1)
            For i = 1 To (ExcelWorksheet.Shapes.Count)
                Set img = ExcelWorksheet.Shapes(i)
                If Not img Is Nothing Then
                    img.Copy
                    Selection.Paste
                    Selection.TypeParagraph
                End If
                Set img = Nothing
            Next
        Set ExcelWorksheet = Nothing
        If abierto = False Then
            ExcelWorkbook.Close False
        End If
        Set ExcelWorkbook = Nothing
        Set ExcelApplication = Nothing
        MsgBox "Proceso Finalizado", vbInformation
    End Sub
    Private Function ArchivoExcel() As String
        Dim dlgAnswer   As String
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .Title = "Selecciona archivo Excel"
            .Filters.Clear
            .Filters.Add "Excel 97-2003", "*.xls"
            .Filters.Add "Excel 2007-2013", "*.xlsx"
            .Filters.Add "Excel Macros", "*.xlsm"
            .Show
            If .SelectedItems.Count = 0 Then
                dlgAnswer = "@"
            Else
                dlgAnswer = .SelectedItems(1)
            End If
        End With
        ArchivoExcel = dlgAnswer
    End Function

Un saludo

AlejandroArroz · el 15 de enero

Buenas utiliza

    Sub ImportaShapes()
        Dim ExcelApplication    As Object 'Excel.Application
        Dim ExcelWorkbook       As Object 'Workbook
        Dim ExcelWorksheet      As Object 'Excel.Worksheet
        Dim img                 As Object 'Shape
        Dim chrt                As Object ' ChartObject
        Dim Nombreimg           As String
        Dim NombreExcel         As String
        Dim i                   As Integer
        Dim abierto             As Boolean
        On Error Resume Next
        NombreExcel = ArchivoExcel
        If NombreExcel = "@" Then
            MsgBox "No se realizo selección de archivo", vbCritical, ""
            Exit Sub
        End If
        Set ExcelApplication = GetObject(, "Excel.Application")
        If Err.Number = 0 Then
            With ExcelApplication
                For i = 1 To .Workbooks.Count
                    If .Workbooks(i).FullName = NombreExcel Then
                        abierto = True
                        Set ExcelWorkbook = .Workbooks(i)
                        Exit For
                    End If
                Next i
            End With
        Else
            Set ExcelApplication = CreateObject("Excel.Application")
            Err.Clear
        End If
        If ExcelWorkbook Is Nothing Then
            Set ExcelWorkbook = ExcelApplication.Workbooks.Open(NombreExcel)
        End If
        Set ExcelWorksheet = ExcelWorkbook.Sheets(1)
            For i = 1 To (ExcelWorksheet.Shapes.Count)
                Set img = ExcelWorksheet.Shapes(i)
                If Not img Is Nothing Then
                    img.Copy
                    Selection.Paste
                    Selection.TypeParagraph
                End If
                Set img = Nothing
            Next
        Set ExcelWorksheet = Nothing
        If abierto = False Then
            ExcelWorkbook.Close False
        End If
        Set ExcelWorkbook = Nothing
        Set ExcelApplication = Nothing
        MsgBox "Proceso Finalizado", vbInformation
    End Sub
    Private Function ArchivoExcel() As String
        Dim dlgAnswer   As String
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .Title = "Selecciona archivo Excel"
            .Filters.Clear
            .Filters.Add "Excel 97-2003", "*.xls"
            .Filters.Add "Excel 2007-2013", "*.xlsx"
            .Filters.Add "Excel Macros", "*.xlsm"
            .Show
            If .SelectedItems.Count = 0 Then
                dlgAnswer = "@"
            Else
                dlgAnswer = .SelectedItems(1)
            End If
        End With
        ArchivoExcel = dlgAnswer
    End Function

Un saludo

Muchisimas gracias! Ya me funciona.

Solo tengo un par de preguntas al respecto:

- Por que es mejor inicializar los objetos como Object y luego mas tarde asignarles una clase?

- Al final, la instruccion "ExcelWorkbook.Close False" no la acabo de entender... Por que no "ExcelWorkbook.Close" a secas?

Lo dicho, muchas gracias y un saludo

logroastur · el 16 de enero

Buenas vamos por partes

Bien en cuanto

- Por que es mejor inicializar los objetos como Object y luego mas tarde asignarles una clase?

Bien si te refieres a que las variables están declaradas como Object en vez de su respectiva Clase, la razón es que de esta forma no es preciso tener que realizar selección en referencia alguna.

Es decir si se usa

Dim ExcelApplication As Excel.Application

Para la rutina te funcione correctamente deberás de tener marcada la referencia de Microsoft Office, bien no existiría mayor problema si el código y/o archivo no se usa en en una maquina distinta a la actual.

Pero por ejemplo imagínate que en tu pc posees el Excel 2013 por lo que deberás de tener marcada dicha referencia, y posteriormente debes de usar el archivo en otra maquina y esta posee el Excel 2007, bien al ejecutar la rutina te generara error por que la referencia usada no existe

Dim ExcelApplication As Object

Sin embargo si se usa esto no sera preciso poseer ninguna referencia marcada

y en cuanto a

- Al final, la instruccion "ExcelWorkbook.Close False" no la acabo de entender... Por que no "ExcelWorkbook.Close" a secas?

Bien la única diferencia radica en que si se usa sin indicar que los cambios se guardan o no, y se porduce un cambio o actualización de vínculos, fórmulas, etc; entonces lanzara consulta sobre que se desea realizar.

Bien para evitar esto se coloca la orden de no guardar cambios, por lo que no lanzara mensaje y evitaremos que no se modifique el archivo por error.

Un saludo