Discussion :

[stef3700]

Bonjour a tous je cherche une âme charitable pour mon problème voir code
Merci d'avance.

La Feuil15 correspond a mes Données

Explication du code pour celui si correspond a une sauvegarde avec PDF du fichier en court mais moi je cherche pour une Sauvegarde simplement en PDF depuis la feuil15 en C13 ou j'ai déjà renseigner dans le code mais qui ne fonctionne pas .
Le UserForm avec la Listebox (oui actionne par image ) la pas de soucis je peux sélectionner les actions pour choisir les onglets.

Le But d'avoir un PDF différant que l'original .

Merci..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Image6_Click() 'Fermer_Classeur_avec_PDF
' Protege le classeur
              Dim Feuille As Worksheet
              For Each Feuille In ThisWorkbook.Worksheets
              If Feuille.Name <> "" Then Feuille.Protect "55", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowSorting:=True
              Next
Dim Rep As Long, sFichier As String
Dim FSO As Object
    sFichier = Feuil15.Range("C13")
    If NomFichierValide(sFichier) Then
        Rep = MsgBox("Voulez-vous vraiment quitter pour imprimer EN pdf" , vbYesNo)
        If Rep = vbYes Then
            Set FSO = CreateObject("Scripting.FileSystemObject")
            If FSO.FileExists(ThisWorkbook.Path & "\" & sFichier & ".pdf") Then
                Rep = MsgBox("Le fichier pdf existe déjà, confirmer son écrasement ?", vbYesNo)
                If Rep = vbYes Then SavePDF_XLS ThisWorkbook.Path & "\" & sFichier
            Else
                SavePDF_XLS ThisWorkbook.Path & "\" & sFichier
            End If
            Set FSO = Nothing
        End If
    Else
        Feuil15.Range("C13").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly
    End If
    Unload MENU
End Sub
Private Function NomFichierValide(sChaine As String) As Boolean
Dim I As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For I = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, I, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next I
End Function
Private Sub SavePDF_XLS(sNomFichier As String) ' Pour choisir les onglet en PDF
Dim Ar(1) As String
    Ar(0) = "TOTO"
    Ar(1) = "TITI"
        Application.ScreenUpdating = False
    Sheets(Ar).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=sNomFichier & ".pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=True
'Permer de ranger les cellule par defaut sur chaque onglet
    Sheets("TOTO").Select
    Range("C1").Select
    Sheets("TITI").Select
    Range("B1").Select
     '
    Sheets("TOTO").Visible = True
    Sheets("TITI").Visible = False
    Range("A2").Select
    '
    On Error Resume Next
    ThisWorkbook.SaveCopyAs sNomFichier & ".xlsm"
    On Error GoTo 0
    Application.ScreenUpdating = True
    Unload MENU
    ActiveWorkbook.Save 'Fermeture Avec sauvegarde
    CancelSortie = False 'reactive la croix de fermeture
    ActiveWorkbook.Close
 
End Sub

[kiki29]

Salut, quand tu sauras ce que tu veux ..... 1 2 etc

[stef3700]

Oui effectivement mais plus j'avance plus je me rencontres qu'il me faut des actions dans mon fichier. Car en final j'essaie de veroullier mon fichier pour éviter que les futurs utilisateurs m'apporte la pagaille. la possibilité d'imprimer en PDF nommés si dessus reste d'actualité.
J'essaie de me renseigner sur les tuto ,fofo .mais c'est vrai je suis novice puis ma femme râle pas mal.
Voilà ma situation à se jour.
Juste de l'aide SVP
Merci

[kiki29]

Salut,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Sub EnregistrementPDF()
Dim Rep As Long, sFichier As String
Dim FSO As Object
    sFichier = Feuil15.Range("C13")
    If NomFichierValide(sFichier) Then
        Rep = MsgBox("Voulez-vous vraiment quitter pour imprimer EN pdf", vbYesNo)
        If Rep = vbYes Then
            Set FSO = CreateObject("Scripting.FileSystemObject")
            If FSO.FileExists(ThisWorkbook.Path & "\" & sFichier & ".pdf") Then
                Rep = MsgBox("Le fichier pdf existe déjà, confirmer son écrasement ?", vbYesNo)
                If Rep = vbYes Then SavePDF ThisWorkbook.Path & "\" & sFichier
            Else
                SavePDF ThisWorkbook.Path & "\" & sFichier
            End If
            Set FSO = Nothing
        End If
    Else
        Feuil15.Range("C13").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly
    End If
 
End Sub
 
Private Function NomFichierValide(sChaine As String) As Boolean
Dim I As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For I = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, I, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next I
End Function
 
Private Sub SavePDF(sNomFichier As String)
Dim Ar(0) As String
 
    Ar(0) = Feuil15.Name
    Application.ScreenUpdating = False
    Sheets(Ar).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=sNomFichier & ".pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
    With Feuil15
        .Select
        .Range("A2").Select
    End With
 
    Application.ScreenUpdating = True
End Sub

[stef3700]

Merci presque ca
pour avoir la possibilité depuis la sélection de la ListBox en si dessous en multi sélections .

Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub UserForm_Initialize()
Dim wk As Worksheet
    For Each wk In ThisWorkbook.Worksheets
    If wk.Name <> "Feuil01" Then
    If wk.Visible = True Then
    ListBox1.AddItem wk.Name
    End If
    End If
    Next
End Sub
Private Sub CommandButton1_Click()
'--- Déclaration des variables
Dim I As Integer
Dim Feuille() As Variant
Dim NbFeuille As Integer
'--- Impression des onglets sélectionnés
 With ListBox1
    For I = 0 To .ListCount - 1
      If .Selected(I) Then
        ReDim Preserve Feuille(NbFeuille)
        Feuille(NbFeuille) = .List(I)
        NbFeuille = NbFeuille + 1
      End If
    Next I
    End With
    '--- Impression des feuilles listées
  With Sheets(Feuille)
       .PrintOut
        'PrintPreview 'en preview Bug
  End With
    Unload Me
    End
End Sub

[stef3700]

Bonsoir j'ai besoins d"aide SVP
pour enregistré en PDF depuis la ListBox1 en sélection divers car je peux choisir dedans les différents onglets qui s’affiche puis avec comme nom en Feuil15.Range("C13")
car la je suis coincer je comprend plus rien après les test
Merci