XL 2013 Macro clique enregistre en pdf

[jeromeN95]

Bonjour à tous,
feuille "Sommaire", un icone pour cliquer et ca enregistre les feuilles (de 1 à la dernière), en format PDF dans le dossier.

Sub CrationPNDenPDF()
Dim sNomFichierPDF As String 'pour PDF
Dim i%
Dim stFeuille As String   'pour logo et pictogramme
'''PDF'''
If Sheets.Count < 3 Then Exit Sub
Sheets(3).Select
For i = 3 To Sheets.Count
    Sheets(i).Select False 'sélection multiple
Next
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Range("Sommaire!C27").Value
Sheets(3).Select
'''PDF'''
Application.ScreenUpdating = True
    MsgBox "La création des PND est terminée. BRAVO !", vbInformation, "P.N.D. par Jérôme"
End Sub

Jusque la, c'est ok. Mais il ne m'affiche pas toute les images car les feuilles sont sélectionner et les images supprimer (pour gagner en taille fichier).


Dans "ThisWorkbook" :

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim c As Range, S As Shape
Application.ScreenUpdating = False
On Error Resume Next
For Each c In Sh.[E:E].SpecialCells(xlCellTypeFormulas)
    Set S = Nothing
    Set S = Sheets("LISTE").Shapes(c)
    If Not S Is Nothing Then
        c(1, 0).Select
        S.CopyPicture
        Sh.Paste
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.Width = c(1, 0).Width
        Selection.Height = c(1, 0).Height
    End If
Next
Application.Goto Sh.[A1], True 'cadrage
ActiveCell.Copy ActiveCell 'vide le presse-papiers
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim S As Shape
For Each S In Sh.Shapes
    If Not Intersect(S.TopLeftCell, Sh.Range("D4:D18")) Is Nothing Then S.Delete
Next
End Sub

Et c'est là le problème… je supprime les images, mais j'aimerai faire une macro sans la suppression...
J'aimerai une idée svp.

 

[job75]

Bonjour jeromeN95,

Le fichier en retour avec la bonne macro :

Public flag As Boolean 'mémorise la variable pour la Workbook_SheetDeactivate

Sub CrationPNDenPDF()
Dim sNomFichierPDF As String 'pour PDF
Dim i%
Dim stFeuille As String   'pour logo et pictogramme

If Sheets.Count < 3 Then Exit Sub

flag = True
For i = 3 To Sheets.Count: Sheets(i).Select: Next 'pour copier les images
flag = False

'''PDF'''
Application.EnableEvents = False
Sheets(3).Select
For i = 3 To Sheets.Count
    Sheets(i).Select False 'sélection multiple
Next
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Range("Sommaire!C27").Value
Sheets(2).Select
Application.EnableEvents = True
'''PDF'''

For i = Sheets.Count To 2 Step -1
    Sheets(i).Select  'pour supprimer les images
Next
    
Application.ScreenUpdating = True
MsgBox "La création des PND est terminée. BRAVO !", vbInformation, "P.N.D. par Jérôme"
End Sub

La Workbook_SheetDeactivate a été aussi complétée.

A+

 

[job75]

Avec un 2ème flag on évite une 2ème copie d'images, on gagne du temps :

Public flag1 As Boolean 'mémorise la variable pour la Workbook_SheetDeactivate
Public flag2 As Boolean 'mémorise la variable pour la Workbook_SheetActivate

Fichier (4).

 

[jeromeN95]

Super, ca fonctionne et c'est vrai que c'est un peu plus rapide.

Merci.