Visual Basic para Aplicaciones - AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Life is soft - evento anual de software empresarial

Pos: 70

Val: 11

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por AMBROSIO RODRIGUEZ (3 intervenciones) el 29/06/2019 07:08:36

Hola!
Estoy trabajando en una Macro que inserte imágenes en una hoja de excel desde una carpeta local.
La idea es que utilizando las referencias de una tabla (Columna B), la Macro busque las imágenes en una carpeta local e inserte dichas imágenes en la celda correspondiente (Columna A).
Para ello utilicé un bucle While.
Adicionalmente, agregué un manejador de errores On Error Goto, para que cuando en la carpeta no se encuentre algunas de las fotos, la Macro inserte una "Carita Triste" y el bucle continue su ejecución hasta que consiga una celda vacía en la Columna B.
Sin embargo cuando ejecuto la Macro, al llegar a una celda cuya foto no se encuentra y la Macro inserta la "carita triste", se detiene el bucle.

Aquí dejo el código de VBA:

Sub Insertar ()

On Error GoTo carita

Dim n As Integer

Dim fila As Integer

    While Cells(fila, "B").Value <> ""

        Dim FULL As String

        FULL = (("C:\Users\XXX\Documents\CARPETA1\CARPETA2\") & (Cells(fila, "B")) & (".jpg"))

        Cells(fila, "A").Select

        Dim Ph As Picture

        Set Ph = Worksheets("Hoja1").Pictures.Insert(FULL)

        Ph.Width = 100

        Ph.Height = 50

        Ph.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Ph.Width) / 2

        Ph.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Ph.Height) / 2

        n = n + 1

        fila = fila + 1

        Wend

    Exit Sub

carita:

Dim Px As Picture

Set Px = Worksheets("Hoja1").Pictures.Insert("C:\Users\XXX\Documents\CARPETA1\CARPETA2\NOMBRE DEL ARCHIVO.jpg")

Px.Width = 40

Px.Height = 58

Px.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Px.Width) / 2

Px.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Px.Height) / 2

End Sub

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 5

Val: 138

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por gilman (47 intervenciones) el 30/06/2019 10:52:48

El problema es como estableces el control de errores, que proboca que cada vez que se produzca un error se salga del bucle con lo que no se continua con la carga de las siguientes imagenes.
En el siguiente código tienes una posible solución:

Sub Insertar()

    'Esta sentencia provoca que cuando se produce un error (la imagen no existe)

    'saltemos a la etiqueta carita, con lo que nos salimos del bucle y no continuemos

    'cargando las imagenes, así que la comentamos

    'On Error GoTo carita

    Dim n As Integer

    Dim fila As Integer

    While Cells(fila, "B").Value <> ""

        Dim FULL As String

        FULL = (("C:\Users\XXX\Documents\CARPETA1\CARPETA2\") & (Cells(fila, "B")) & (".jpg"))

        Cells(fila, "A").Select

        Dim Ph As Picture

        On Error Resume Next

        'Si la siguiente sentencia falla Err.Number será distinto de cero

        Set Ph = Worksheets("Hoja1").Pictures.Insert(FULL)

        If Err.Number = 0 Then

            'la imagen existe

            'recuperar el control de errores por si acaso

            On Error GoTo 0

            Ph.Width = 100

            Ph.Height = 50

            Ph.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Ph.Width) / 2

            Ph.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Ph.Height) / 2

        Else

            'Si se a producido un error insertar una carita triste

            'recuperar el control de errores por si acaso

            On Error GoTo 0

            Dim Px As Picture

            Set Px = Worksheets("Hoja1").Pictures.Insert("C:\Users\XXX\Documents\CARPETA1\CARPETA2\NOMBRE DEL ARCHIVO.jpg")

            Px.Width = 40

            Px.Height = 58

            Px.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Px.Width) / 2

            Px.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Px.Height) / 2

        End If

        n = n + 1

        fila = fila + 1

    Wend

    'el siguiente código ya no es necesario

'    Exit Sub

'carita:

'    Dim Px As Picture

'    Set Px = Worksheets("Hoja1").Pictures.Insert("C:\Users\XXX\Documents\CARPETA1\CARPETA2\NOMBRE DEL ARCHIVO.jpg")

'    Px.Width = 40

'    Px.Height = 58

'    Px.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Px.Width) / 2

'    Px.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Px.Height) / 2

End Sub

Aunque, como es lógico no he podido probarlo, debería funcionar

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 70

Val: 11

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por AMBROSIO (3 intervenciones) el 01/07/2019 01:38:34

Gilman,
De ante mano gracias por tu intervención. Te cuento que la misma me sirvió de gran ayuda.
Tomando en cuenta tu consejo modifiqué mi Macro y la misma funciona correctamente.

Finalmente y aplicando mi propia interpretación, el Bucle quedó así:

While Cells(fila, "B").Value <> ""

    FULL = (("C:\Users\MI EQUIPO\Documents\CARPETA1\CARPETA2\") & (Cells(fila, "B")) & (".jpg"))

    On Error Resume Next

    Cells(fila, "A").Select

    Set Ph = Worksheets("Hoja1").Pictures.Insert(FULL)

    If Err.Number <> 0 Then

        Set Ph = Worksheets("Hoja1").Pictures.Insert("C:\Users\MI EQUIPO\Documents\CARPETA1\CARPETA2\crazy.jpg")

        Ph.Width = 40

        Ph.Height = 58

        Ph.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Ph.Width) / 2

        Ph.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Ph.Height) / 2

    End If

    If Err.Number = 0 Then

        Ph.Width = 40

        Ph.Height = 58

        Ph.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Ph.Width) / 2

        Ph.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Ph.Height) / 2

    End If

    n = n + 1

    fila = fila + 1

Wend

Valora esta respuesta

Comentar

Pos: 1

Val: 1.134

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por Antoni Masana (502 intervenciones) el 30/06/2019 16:49:16

Una pregunta tonta:

Cuendó llega al While la primera ves ¿Cuanto vale FILA?

Otra del Mismo tipo

Después de poner la caríta triste ¿Que debe hacer? ¿Finalizar porque esta triste?

Hay una forma mejor de verificar si existe y es con un DIR()

Sub Insertar ()

    Dim n As Integer, fila As Integer, FULL as String, Ph as Pivture

    Fila = 1

    While Cells(fila, "B").Value <> ""

...

        FULL = (("C:\Users\XXX\Documents\CARPETA1\CARPETA2\") & (Cells(fila, "B")) & (".jpg"))

        Cells(fila, "A").Select

        If Dir(Full)="" Then

            Set Px = Worksheets("Hoja1").Pictures.Insert("C:\Users\XXX\Documents\CARPETA1\CARPETA2\NOMBRE DEL ARCHIVO.jpg")

            Px.Width = 40

            Px.Height = 58

            Px.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Px.Width) / 2

            Px.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Px.Height) / 2

        Else

            Set Ph = Worksheets("Hoja1").Pictures.Insert(FULL)

            Ph.Width = 100

            Ph.Height = 50

            Ph.Left = Cells(fila, "A").Left + (Cells(fila, "A").Width - Ph.Width) / 2

            Ph.Top = Cells(fila, "A").Top + (Cells(fila, "A").Height - Ph.Height) / 2

            n = n + 1

        End If

        fila = fila + 1

    Wend

End Sub

Saludos.
\\//

Valora esta respuesta

Comentar

Pos: 70

Val: 11

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por AMBROSIO (3 intervenciones) el 01/07/2019 01:33:17

De ante mano gracias por tu tiempo.

Después de insertar una carita triste, el bucle debería continuar su ejecución, hasta que consiga una celda vacía "", en la columna "B".

En el primer bucle, fila=13

Saludos!

Valora esta respuesta

Comentar

Pos: 1

Val: 1.134

AYUDA PARA REPARAR MACRO QUE INSERTA IMAGENES DESDE UNA CARPETA LOCAL USANDO BUCLE WHILE

Publicado por Antoni Masana (502 intervenciones) el 01/07/2019 14:48:14

¿Viste mi código?

Solo hace falta una pequeña corrección

Sub Insertar ()

    Dim n As Integer, fila As Integer, FULL as String, Ph as Pivture

    Fila = 13    ' <-- Linea de inicio

    While Cells(fila, "B").Value <> ""

...

Saludos.
\\//_

Valora esta respuesta

Comentar

Calculadora visual basic en excel

Numerador automático Excel