XL 2013 Exporter des onglets masqués

momo

XLDnaute Occasionnel
Bonjour le forum

j'ai une macro q qui masque les feuilles de mon classeur et ne montre que la feuille active.

Il y a des bouton qui permettent de faire la navigation.

Mon soucis est celui-ci,

- Lorsque j'intègre la macro qui me sert à importer les feuilles du classeur (Possibilité de faire un choix des feuilles à exporter), j'ai une erreur "Alerte 1004". je me demandais si il était possible de faire en sorte que je n'ai pas cette alerte

- Aussi je voudrais également que le nom de l'onglet actif n'apparaisse plus

je mets en PJ un exemple du fichier
 

Fichiers joints

youky(BJ)

XLDnaute Barbatruc
Hello
Quelques ajouts
Sheets(I + 1).Visible = 1
et en bas
For I = 0 To ListBox1.ListCount - 1

If ListBox1.Selected(I) Then Sheets(I + 1).Visible = 2

Next I
VB:
Private Sub Button1_Click()
Dim Chemin$, Fiche$, NomFiche$
Dim SheetArray() As Variant
Dim I&, Indx&
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fiche = "TEST.pdf"
Indx = 0
    For I = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(I) Then
            ReDim Preserve SheetArray(Indx)
            SheetArray(Indx) = ListBox1.List(I)
            Sheets(I + 1).Visible = 1
            Indx = Indx + 1
        End If
    Next I

    If Indx > 0 Then
      Application.ScreenUpdating = False
        Sheets(SheetArray()).Select
        NomFiche = Chemin & Fiche
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=NomFiche, _
              Quality:=xlQualityMinimum, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
    End If
Erase SheetArray
Feuil1.Select
  For I = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(I) Then Sheets(I + 1).Visible = 2
  Next I
    Unload Me
Application.Goto [A1], True
End Sub
et aussi
VB:
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name <> "Accueil" Then Sh.Visible = 2
End Sub
Bruno
 

cp4

XLDnaute Impliqué
Bonjour,

Remplace par ceci
VB:
With Sheets(SheetArray()) 'au lieu de .select
         NomFiche = Chemin & Fiche
         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                         Filename:=NomFiche, _
                                         Quality:=xlQualityMinimum, _
                                         IncludeDocProperties:=True, _
                                         IgnorePrintAreas:=False, _
                                         OpenAfterPublish:=False
      End With
Attention! si la ou les feuilles à exporter sont vides tu auras un message qu'il n'y a rien à imprimer.

edit: Bonjour Youky;)
 

youky(BJ)

XLDnaute Barbatruc
Bonjour Cp4,
J'ai testé avec le with (sans succès)
Dommage c'était une bonne idée.
Momo dans ma macro mets -1 au lieu de 1
Sheets(I + 1).Visible = -1
Bruno
 

momo

XLDnaute Occasionnel
Bonjour Bruno, Bjr CP4
J'ai testé avec le with (sans succès)
En effet Avec la méthode With la macro n'a pas marché non plus

Par contre Bruno, ton code quand je l'ai essayé il m'a renvoyé une alerte "Erreur 1004" (la méthode select de la case sheet a échoué) sur sheet(sheetarray()).select
 

youky(BJ)

XLDnaute Barbatruc
Ben oui avant j'ai cru que c'était ok et non
Donc j'ai modifié
la methode .copy crée un fichier qui sert au PDf et ce fichier est fermé sans sauvegarde
Bruno
VB:
Private Sub Button1_Click()
Dim Chemin$, Fiche$, NomFiche$
Dim SheetArray() As Variant
Dim I&, Indx&
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fiche = "TEST.pdf"
Indx = 0
    For I = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(I) Then
            ReDim Preserve SheetArray(Indx)
            SheetArray(Indx) = ListBox1.List(I)
            Sheets(I + 1).Visible = 1
            Indx = Indx + 1
        End If
    Next I

    If Indx > 0 Then
      Application.ScreenUpdating = False
        Sheets(SheetArray()).Select
        NomFiche = Chemin & Fiche
           Sheets(SheetArray()).Copy
           ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=NomFiche, _
              Quality:=xlQualityMinimum, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
    End If
    ActiveWorkbook.Close (False)
Erase SheetArray
  For I = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(I) Then Sheets(I + 1).Visible = 2
  Next I
    Unload Me
Application.Goto [A1], True
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas