I'm working on a code to execute a macro that prints different sheets of a book in Excel based on a series of variables.
Step by step, the macro executes correctly at 100% but from its assigned button, the cards are printed correctly, except for the images, which do not update / change them.
In case one of you can throw a cable, I leave the code with the sub macros
Thank you very much in advance
'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'
When changing to the sheet File or Image File and clicking on any cell, its corresponding images are updated with a code with the following structure
'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'
Macros 4 and 5 have code.
'Select
Sub Macro4(subir)
Range("BD" & subir).Select
End Sub'
-------------------------------------------- EDITED
I forgot to comment that I'm working on Excel 2016. I have tried to run the macro on a more powerful server that uses 2010, without errors.
I do not know if it's a problem with unsupported VBA code or a resource issue
Thank you very much