Error Macro impresion fichas
Publicado por Victor (1 intervención) el 31/07/2018 14:51:31
Buenas tardes...y saludos a toda la comunidad
Estoy trabajando en un codigo para ejecutar una macro que imprima diferentes hojas de un libro en Excel en funcion 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
----------------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------------
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 Wo
----------------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------------
Las Macros4 y 5 tienen codigo .Select
Estoy trabajando en un codigo para ejecutar una macro que imprima diferentes hojas de un libro en Excel en funcion 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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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 Wo
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
rksheet_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 = MiRutaEOn 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.NumberCase 53
ImgA.Picture = LoadPicture(PicAddress0)
End Select
ControlErrorB: Select Case Err.NumberCase 53
ImgB.Picture = LoadPicture(PicAddress0)
End Select
ControlErrorC: Select Case Err.NumberCase 53
ImgC.Picture = LoadPicture(PicAddress0)
End Select
ControlErrorD: Select Case Err.NumberCase 53
ImgD.Picture = LoadPicture(PicAddress0)
End Select
ControlErrorE: Select Case Err.NumberCase 53
ImgE.Picture = LoadPicture(PicAddress0)
End Select
End Sub
----------------------------------------------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------------------------------------------
Las Macros4 y 5 tienen codigo .Select
1
2
3
4
5
Sub Macro4(subir)
Range("BD" & subir).Select
End Sub
Valora esta pregunta
0