[XL-2003] Muli selection sheets VBA

Muli selection sheets VBA

Bonjour,

Je coince sur une fonction qui permet d’exporter en pdf une sélection de feuille dans un document.xls.

J’ai les noms de toutes les feuilles visibles d’un document.xls dans une liste box.
Je sélectionne les feuilles à imprimer dans la liste box.
Je sais identifier les feuilles à imprimer.
Où je coince, c’est pour sélectionner plusieurs feuilles dans une macro VBA.

Soit faire l’équivalent de la macro ci dessous enregistré dans Excel dans un code VBA.
Code:

1 2 Sheets(Array("Cover", "Tutorial1", "Tutorial2")).Select
Merci d’avance aux experts qui ont une solution à ce problème.

Salut,
voici un exemple, c'est le code du bouton de validation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub CommandButton1_Click()
 
Dim Nom_Feuilles() As Variant, j, n
 
n = Me.ListBox1.ListCount
j = 0
 
For i = 0 To n - 1
    If Me.ListBox1.Selected(i) = True Then
        ReDim Preserve Nom_Feuilles(j)
        Nom_Feuilles(j) = Me.ListBox1.List(i)
        j = j + 1
    End If
Next
 
If j > 0 Then
    Sheets(Nom_Feuilles()).Select
End If
 
Me.Hide
 
End Sub

si tu as besoin d'explication, je peux t'en fournir.
bon courage

Bonjour MN Archi,

Merci pour ton exemple qui s'applique parfaitement à mon script.

Ci-joint pour les amateurs comme moi un exemple pour envoyer un pdf dans un mail d'une selection de feuilles dans un document.xls

Code:

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
Private Sub CmdExport_Click()
'Impression selection sheet
 
'Selection dans listebox
Dim Nom_Feuilles() As Variant, j, n
 
n = Me.ListSheet.ListCount
j = 0
 
For i = 0 To n - 1
    If Me.ListSheet.Selected(i) = True Then
        ReDim Preserve Nom_Feuilles(j)
        Nom_Feuilles(j) = Me.ListSheet.List(i)
        j = j + 1
    End If
Next
 
If j > 0 Then
    Sheets(Nom_Feuilles()).Select
End If
 
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
NomPDF = Range("J5") & "-" & Left(NomExcel, Len(NomExcel) - 4) & "-" & Format(Date, "dd-mm-yyyy") & ".pdf"
 
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("AutosaveFilename") = NomPDF
'   0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
.cOption("AutosaveFormat") = 0
.cClearCache
End With
 
ActiveWindow.SelectedSheets.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
 
   Dim MailApp As New Outlook.Application
   Dim NewMail As MailItem
   Dim Dest As String 'Destinataire du mail
 
   Set MailApp = New Outlook.Application
   Set NewMail = MailApp.CreateItem(NewMailItem)
 
   With NewMail
'        Dest = "adresse1@voila.fr" + ";" + "adresse2@voila.fr" 'Ainsi de suite
'        .To = Dest
        .Subject = "Sujet du mail"
        .Attachments.Add ThisWorkbook.Path & "\" & NomPDF
 '       "C:\Users\A-youssef\Desktop\commandes\" & Range("D4") & ".pdf"
 '       .Body = "Blablabla" 'Message
        .Importance = olImportanceNormal 'Importance du mail normal
        .ReadReceiptRequested = False 'Accusé de lecture
        .Display 'Visualise le mail avant envoie (ou Send qui envoie directement le mail sans visualisation) soit l'un soit l'autre jamais les 2
   End With
 
Set selectedSheet = Nothing
 
Call Me.Hide
 
End Sub
 
Private Sub UserForm_Initialize()
Dim i As Integer
ListSheet.Clear
For i = 1 To ThisWorkbook.Worksheets.Count
    If ThisWorkbook.Worksheets.Item(i).Visible = -1 Then
    ListSheet.AddItem (ThisWorkbook.Worksheets.Item(i).Name)
    End If
Next i
End Sub