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
 

Pièces jointes

  • Essais_Masque.xlsm
    41.5 KB · Affichages: 16

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 Barbatruc
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
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
 

Discussions similaires

Statistiques des forums

Discussions
311 543
Messages
2 080 552
Membres
101 243
dernier inscrit
RAYANN