Action sur 3 onglets différents

Hello à tous,

Pouvez-vous m'aider à créer un code qui s'applique sur des différents onglets ?

tant bien que mal, j'ai essayer ce bout de code mais sans succès!

Merci d'avance

Sub Savepdf()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.ThisWorkbook.Saved = False

Set sh = Worksheets(Array(3, 6, 10))

On Error Resume Next

Application.OnTime tps, Procedure:="GuidoNow", Schedule:=False
Set tps = Nothing
fichier = "H:\Merchandise Retail and Revenue Enhancement\Legends of Hollywood Support Caisse\Checklist Ouverture\Checklist Ouverture.pdf" 'à adapter

With sh.PageSetup

.FitToPagesWide = 1
.FitToPagesTall = 0
.Orientation = xlLandscape

End With

a = MsgBox("would you like to send ?", vbYesNo)
If a = vbNo Then Exit Sub
If a = vbYes Then
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Application.ScreenUpdating = True
Application.ThisWorkbook.Saved = True
Application.DisplayAlerts = True
End If

End Sub

Setila

Bonjour Setila,

Pour que le code s'applique à différent onglet, il faut simplement définir la feuille active

Sub SavePDF()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.ThisWorkbook.Saved = False
  ' Définir l'objet feuille active
  Set sh = ActiveSheet
  ' En cas d'erreur
  On Error Resume Next
  ' Aucune idée à quoi servent les 2 lignes ci-dessous mises en commentaire
  'Application.OnTime tps, Procedure:="GuidoNow", Schedule:=False
  'Set tps = Nothing
  fichier = "H:\Merchandise Retail and Revenue Enhancement\Legends of Hollywood Support Caisse\Checklist Ouverture\Checklist Ouverture.pdf" 'à adapter
  With sh.PageSetup
    .FitToPagesWide = 1
    .FitToPagesTall = 0
    .Orientation = xlLandscape
  End With
  ' Question à l'utilisateur
  If MsgBox("would you like to send ?", vbYesNo) = vbYes Then
    sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
      Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=False
  End If
  ' remettre la gestion normale d'erreur
  On Error GoTo 0
  ' Réactiver
  Application.ScreenUpdating = True
  Application.ThisWorkbook.Saved = True
  Application.DisplayAlerts = True
End Sub

@+

Bonjour BrunoM45,

Merci pour ta réponse.

Comment faire pour appliquer le code uniquement aux onglets 3 et 10 ?

J'ai testé ça :

sub savepdf()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Application.ThisWorkbook.Saved = False

' Définir l'objet feuille active 
Dim sh(1) As String

sh(0) = "Zone 2"
sh(1) = "RECAP"

On Error Resume Next

fichier = "H:\Merchandise Retail and Revenue Enhancement\Legends of Hollywood Support Caisse\Checklist Ouverture\Checklist Ouverture.pdf" 'à adapter

With Sheets(sh).PageSetup

.FitToPagesWide = 1
.FitToPagesTall = 0
.Orientation = xlLandscape

End With
' Question à l'utilisateur

a = MsgBox("would you like to send ?", vbYesNo)
If a = vbNo Then Exit Sub
If a = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' remettre la gestion normale d'erreur

On Error GoTo 0

' Réactiver

Application.ScreenUpdating = True
Application.ThisWorkbook.Saved = True
Application.DisplayAlerts = True

End If

End Sub

Edit : merci de mettre le code entre balises grâce au bouton, </>

Petit up

Bonjour Setila,

Cette Sub est normalement lancée par un bouton, oui ou non ?

Si elle est lancée par un bouton est-ce que celui-ci se trouve sur la feuille concernée ?

@+

Bonjour Bruno,

Oui la sub est lancée par un bouton et elle se trouve sur la feuille.

La sub doit s'actioner sur la feuille concernée ainsi que sur la feuille RECAP

@+

Setila

Bonjour Setila,

Désolé, je pensais que tu connaissais VBA

Edit : fichier corrigé (BeforeClose supprimé)

Voici ton fichier modifié, avec une seule Sub pour toutes tes feuilles, sub avec paramètre envoyé.

@+

Hello BrunoM45,

Je pense que la Sub n'a pas été enregistré ?

Merci d'avance.

Setila

Re,

Bravo d'avoir mis dans ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
End Sub

Je comprends pourquoi mes modifications n'ont pas été enregistrées et je suis passé à côté

Récupère le fichier modifié du précédent post

@+

Re,

Haha , sorry

Merci beaucoup

A bientôt

Setila