0

Estoy trabajando en un código para ejecutar una macro que imprima diferentes hojas de un libro en Excel en función de una serie de variables.

Paso a paso, la macro se ejecuta correctamente al 100% pero desde su boton asignado, se imprimen las fichas de manera correcta, salvo por las imagenes, que no las actualiza/cambia.

Por si alguno de vosotros puede echarme un cable, os dejo el codigo con las sub macros

Muchas gracias de antemano

`Sub Imprimir_Fichas()

Dim ultimafila, ruta, fila As String

Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
If Direc.Show = 0 Then Exit Sub

directory = Direc.SelectedItems(1) & "\"
Sheets("Print").Activate

ultimafila = Range("A" & Rows.Count).End(xlUp).Row

Range("A2:A" & ultimafila).Select

Dim oCell As Range

For Each oCell In Selection

Sheets("input").Activate
Range("A23") = oCell.Value
Calculate
Nombre = Range("A23")
Borrower = Range("E23").Value

fila = oCell.Row
'Sheets("input").Activate
'Sheets("input").Range("A23") = Range("B" & fila).Value
Borrower = Range("E23").Value

subir = subir + 1
Sheets("Ficha").Select
'Range("Q20").Select
Call Macro4(subir)
Application.Wait (Now + TimeValue("00:00:03"))
'Application.Wait (Now + TimeValue("00:00:01"))

'Call Macro1

Sheets("Breakdown analysis").AutoFilter.ApplyFilter
Sheets("DataTape").AutoFilter.ApplyFilter

'Sheets("Ficha").Select
'Range("C3").Select
'Call Macro4

Sheets("FichaImagenes").Select

'Range("C3").Select
Call Macro5(subir)
Application.Wait (Now + TimeValue("00:00:03"))
'Application.Wait (Now + TimeValue("00:00:01"))

'Call Macro3

Sheets(Array("Ficha", "Breakdown analysis", "FichaImagenes")).Select

Calculate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
directory & Borrower & "-" & Nombre & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Sheets("input").Select


Next

End Sub`

Al cambiar a la hoja Ficha o Fichaimagenes y pinchar en cualquier celda, se actualizan sus correspondientes imagenes con un codigo con la siguiente estructura

`Private Sub Worksheet_SelectionChange(ByVal Target As Range)


On Error Resume Next

MiFoto0 = "blanco.jpg"
MiFotoA = Sheets("Ficha").Range("c2").Value & "_foto.jpg"
MiFotoB = Sheets("Ficha").Range("c2").Value & "_mapa.jpg"
MiFotoC = Sheets("Ficha").Range("c2").Value & "_muni.jpg"
MiFotoD = Sheets("Ficha").Range("c2").Value & "_prov.jpg"
MiFotoE = Sheets("Ficha").Range("c2").Value & "_comps.jpg"

MiRuta0 = ThisWorkbook.Path & "\img\" & MiFoto0
MiRutaA = ThisWorkbook.Path & "\img\" & MiFotoA
MiRutaB = ThisWorkbook.Path & "\img\" & MiFotoB
MiRutaC = ThisWorkbook.Path & "\img\" & MiFotoC
MiRutaD = ThisWorkbook.Path & "\img\" & MiFotoD
MiRutaE = ThisWorkbook.Path & "\img\" & MiFotoE

PicAddress0 = MiRuta0
PicAddressA = MiRutaA
PicAddressB = MiRutaB
PicAddressC = MiRutaC
PicAddressD = MiRutaD
PicAddressE = MiRutaE

On Error GoTo ControlErrorA
If IsError(PicAddressA) Then
ImgA.Picture = LoadPicture(PicAddress0)
Else
ImgA.Picture = LoadPicture(PicAddressA)
End If

On Error GoTo ControlErrorB
If IsError(PicAddress2) Then
ImgB.Picture = LoadPicture(PicAddress0)
Else
ImgB.Picture = LoadPicture(PicAddressB)
End If

On Error GoTo ControlErrorC
If IsError(PicAddress2) Then
ImgC.Picture = LoadPicture(PicAddress0)
Else
ImgC.Picture = LoadPicture(PicAddressC)
End If

On Error GoTo ControlErrorD
If IsError(PicAddress2) Then
ImgD.Picture = LoadPicture(PicAddress0)
Else
ImgD.Picture = LoadPicture(PicAddressD)
End If

On Error GoTo ControlErrorE
If IsError(PicAddress2) Then
ImgE.Picture = LoadPicture(PicAddress0)
Else
ImgE.Picture = LoadPicture(PicAddressE)
End If

ControlErrorA:
Select Case Err.Number
Case 53
ImgA.Picture = LoadPicture(PicAddress0)
End Select
ControlErrorB:
Select Case Err.Number
Case 53
ImgB.Picture = LoadPicture(PicAddress0)
End Select

ControlErrorC:
Select Case Err.Number
Case 53
ImgC.Picture = LoadPicture(PicAddress0)
End Select

ControlErrorD:
Select Case Err.Number
Case 53
ImgD.Picture = LoadPicture(PicAddress0)
End Select

ControlErrorE:
Select Case Err.Number
Case 53
ImgE.Picture = LoadPicture(PicAddress0)
End Select


End Sub`

Las Macros 4 y 5 tienen código.

`Select

Sub Macro4(subir)

Range("BD" & subir).Select

End Sub`

--------------------------------------------EDITADO

Se me olvido comentar que estoy trabajando en Excel 2016. He probado a ejecutar la macro en un servidor más potente que usa 2010, sin que de errores.

No sé si se trata de un problema de código VBA no compatible o un tema de recursos

Muchas gracias

5
  • Bienvenido a SOes Vkhann, te recomiendo leas ¿Como Preguntar? para darle una formulación mas correcta a tu pregunta, ademas has el Recorrido para entender mejor el sitio y ganar tu primer medalla!. Por otra parte siempre que añadas código a tu pregunta, usa el icono {} para darle el formato correcto, o su atajo de teclado Alt+K el 31 jul. 2018 a las 13:08
  • Gracias por la ayuda Federico,
    – vkhann
    el 1 ago. 2018 a las 13:28
  • Lo primero, te sugiero borrar donde pones On Error Resume Next porque puede estar ocultando errores. Lo segundo, si ejecutando con F8 sale todo bien, puede ser por un problema de rendimiento. Digamos que el código se lee más deprisa de lo que tarda en ejecutar la acción. Prueba usando DoEvents en vez de Application.Wait a ver si te coge mejor.
    – Esei
    el 3 ago. 2018 a las 10:50
  • Gracias Elier! He modificado tal y como sugieres pero sigo obteniendo el mismo resultado. Quizá sea problema de rendimiento. Existe alguna alternativa mejor a LoadPicture? un saludo
    – vkhann
    el 6 ago. 2018 a las 11:11
  • Finalmente conseguí que funcionara correctamente cambiando el modo en que se ejecutaba la macro {Worksheet_SelectionChange(ByVal Target As Range)} a {Worksheet_Activate()} y un delay de 3"
    – vkhann
    el 14 ago. 2018 a las 11:05

0

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

Examina otras preguntas con la etiqueta o formula tu propia pregunta.