Sauvegarde Userform en PDF

Version imprimable

30/03/2020, 21h10
oliv481

3 pièce(s) jointe(s)

Sauvegarde Userform en PDF

Bonjour à toutes et tous,
Je suis nouveau dans le domaine de la programmation. J'ai toujours voulut faire de la programmation et je me suis lancé dans le VBA.
Je vous explique mon problème ou plutôt mes 2 problèmes:
En premier, le nom de l'intitulé : Sauvegarde d'un Userform en PDF.
J'ai utilisé le tuto de kiki29 : https://www.developpez.net/forums/d4...r/#post7742208
J'ai fais les tests chez moi et tout fonctionne correctement, le problème se passe sur les autres ordi. Lorsque la fonction est lancé, une erreur s'affiche ("La méthode pastespecial de la class worksheet à échoué).
Je vous fournis les fichiers en pièces jointes. Le fichier à ouvrir est "Bareme temps".
Pièce jointe 550981 Pièce jointe 550989 Pièce jointe 550990
Si vous avez des idées, je suis preneur.
Par contre comme je vous l'ai dit, je suis novice donc je m'excuse déjà pour la façon dont j'ai réalisé le programme.
Merci.
31/03/2020, 08h08
Menhir

Citation:

Envoyé par oliv481

Je vous fournis les fichiers en pièces jointes. Le fichier à ouvrir est "Bareme temps".

Beaucoup de participants actifs de ce forum n'ouvrent pas les fichiers joints.
Lire ceci : https://www.developpez.net/forums/d8...s-discussions/

Citation:

J'ai fais les tests chez moi et tout fonctionne correctement, le problème se passe sur les autres ordi. Lorsque la fonction est lancé, une erreur s'affiche ("La méthode pastespecial de la class worksheet à échoué).

A ma connaissance, l'objet Worksheet n'a pas de méthode PasteSpecial. C'est une méthode de Range.
Mais comme le débugage parle de "classe" Worksheet, ça laisse entendre que l'application comporte une classe qui porte le même nom que cet objet, ce qui serait une très mauvaise idée.
A moins que ce soit une mauvaise utilisation de Worksheet que le débugage traduise comme une classe.

Mais pour comprendre, il faudrait voir le code.
Je te conseille donc de le copier dans un message, de préférence encadré par des balises CODE (l'icone #).

Bonjour et merci de la réponse.
Désolé concernant les fichiers joints, je pensez que ça serais plus facile pour comprendre.
concernant la partie qui bloque, elle fait partie du code de kiki29 que j'ai un peu adapté pour moi :

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
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
 
Private Sub CommandButton1_Click()
' Sauvegarde en PDF l'onglet CABLE
Dim sNomPDF As String
Dim Chemin As String
Dim LaDate As String

    LaDate = Format(DateAdd("m", 0, Date), "dd mm yyyy")
    Chemin = ThisWorkbook.Worksheets("CALCUL COPILOTE").Range("H3").Value

    If Chemin = "" Then
        MsgBox ("Vous n'avez pas importé de Nomenclature !")
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents
 
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
    
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    sNomPDF = ActiveWorkbook.Path & "\" & Chemin & " " & "par" & " " & ComboBox1.Value & " " & "le" & " " & LaDate & ".pdf"
 
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPDF, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
 
Private Sub PrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

Comme c'était un code pré-fait, je pensais que tout fonctionnerais correctement.
Après je me suis posé la question, le code est indiqué pour excel2007.
Sachant que j'utilise excel365, le problème ne pourrais pas venir de la ?

Merci encore.

31/03/2020, 09h25
Menhir

Lorsque tu places un code (surtout aussi long) dans un message, utilise des balises CODE, comme je te l'ai dit dans mon message précédent.

[QUOTE=oliv481;11451705]

Code:

ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

Comme je l'ai dit, PasteSpecial n'est pas une méthode de Worksheet.
Il faut donc que tu places entre ActiveSheet et PasteSpecial une référence (Range ou Cells) de la cellule de destination de la copie.
Lire ça : https://msdn.microsoft.com/fr-fr/lib...6(v=office.15)

Citation:

Comme c'était un code pré-fait, je pensais que tout fonctionnerais correctement.

Tout code doit être étudié, compris et adapté.
Le pur copier/coller fonctionne rarement.

Citation:

Après je me suis posé la question, le code est indiqué pour excel2007.
Sachant que j'utilise excel365, le problème ne pourrais pas venir de la ?

Comme dans ton code je ne vois aucune méthode de copie précédent le PasteSpecial, je suppose que le presse-papier est renseigné par PrintScreen.
Je ne connais pas ce terme en tant qu'instruction. Je suppose donc qu'il doit s'agir d'une sous-routine ou autre élément faisant partie du code.
Il se pourrait donc que le code qu'il contient ne fonctionne pas pour ta version de Windows. Donc la copie ne serait pas faite, ce qui empêcherait, de fait, le collage.

Mais c'est difficile à dire sans voir le code de cette sous-routine.

Désolé pour la copie du code, je ne connais pas les balise. J'ai bien mis les # avant et après, je pensais que c'était ça.

Citation:

Envoyé par Menhir

Comme je l'ai dit, PasteSpecial n'est pas une méthode de Worksheet.

Je pensais que cela pouvais fonctionner car j'avais trouvé ça qui correspondais : https://docs.microsoft.com/fr-fr/off...t.pastespecial

Citation:

Envoyé par Menhir

Il faut donc que tu places entre ActiveSheet et PasteSpecial une référence (Range ou Cells) de la cellule de destination de la copie.
Lire ça : https://msdn.microsoft.com/fr-fr/lib...6(v=office.15)

J'ai déjà essayé cette méthode mais cela ne fonctionner pas.

Citation:

Envoyé par Menhir

Comme dans ton code je ne vois aucune méthode de copie précédent le PasteSpecial, je suppose que le presse-papier est renseigné par PrintScreen.
Je ne connais pas ce terme en tant qu'instruction. Je suppose donc qu'il doit s'agir d'une sous-routine ou autre élément faisant partie du code.
Il se pourrait donc que le code qu'il contient ne fonctionne pas pour ta version de Windows. Donc la copie ne serait pas faite, ce qui empêcherait, de fait, le collage.

J'ai fais l'essaie sur plusieurs Windows (7, 10, chez moi) et cela fonctionner bien.

Oui, j'ai oublié un morceau de code qui concerne le PrintScreen.
Code:

1 2 3 4 5 6 7 Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Const VK_SNAPSHOT = 44 Const VK_LMENU = 164 Const KEYEVENTF_KEYUP = 2 Const KEYEVENTF_EXTENDEDKEY = 1
et
Code:

1 2 3 4 5 6 7 Private Sub PrintScreen() keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 End Sub
Concernant le fonctionnement, c'est juste un bouton dans un UserForm qui lance ce code.

Merci.

Bonjour à toutes et tous,

J'ai essayé une nouvelle façon :

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
Private Sub CommandButton1_Click()
' Sauvegarde en PDF l'onglet CABLE
Dim Chemin As String
Dim LaDate As String
Dim sNomPDF As String
Dim wb As Workbook
Dim ws As Worksheet

Set wb = Workbooks("Bareme temps")
Set ws = wb.Worksheets("IMPRIMPDF")
    LaDate = Format(DateAdd("m", 0, Date), "dd mm yyyy")
    Chemin = ThisWorkbook.Worksheets("CALCUL COPILOTE").Range("H3").Value
    
    If Chemin = "" Then
        MsgBox ("Vous n'avez pas importé de Nomenclature !")
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
        
    PrintScreen
    DoEvents

    With ws.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With

    ws.Activate
    Cells(1, 1).Select
    ws.Paste         ' C'est ici que l'erreur ce produit '
      
    sNomPDF = ActiveWorkbook.Path & "\" & Chemin & " " & "par" & " " & ComboBox1.Value & " " & "le" & " " & LaDate & ".pdf"
 
    ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPDF, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    Application.DisplayAlerts = False
    Sheets("IMPRIMPDF").Select
    Selection.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

J'ai créé un onglet fixe que j'ai nommé "IMPRIMPDF".
Je fais exactement le même fonctionnement :
- j'active la feuille,
- je selectionne la cellule A1,
- je colle la copie d'écran.

Mais cela ne fonctionne pas, il me sort une erreur "La méthode 'Paste' de l'objet '_Worksheet' à echoué"
Je ne comprends pas, si vous avez des idées, elles sont les bienvenues.

Merci.

01/04/2020, 16h20
Menhir

A mon avis, le problème ne vient pas du collage (Paste ou PasteSpecial).
Ca plante à cet endroit sans doute parce qu'il essaye de copier alors que le presse-papier est vide.

Le problème vient sans doute de ton processus PrintScreen (ou de PtrSafe ou de la valeur des constantes qui suivent).
Je peux me tromper mais c'est pour moi le coupable le plus probable.
Mais je n'ai pas d'idée pour le corriger.

Essaye de mettre juste avant tes lignes en rouge ws.Cells(2, 2).Copy, juste histoire de voir si ça bugue toujours.
Si ça ne bugue pas, c'est bien que le problème ne se situe pas là.

Ça y est j'ai réussi à dompter la bête.

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
Private Sub CommandButton1_Click()
' Sauvegarde en PDF l'onglet CABLE
Dim sNomPDF As String
Dim Chemin As String
Dim LaDate As String
Dim wb As Workbook
Dim ws As Worksheet
 
Set wb = Workbooks("Bareme temps")
Set ws = wb.Worksheets("IMPRIMPDF")
 
    LaDate = Format(DateAdd("m", 0, Date), "dd mm yyyy")
    Chemin = ThisWorkbook.Worksheets("CALCUL COPILOTE").Range("H3").Value
    sNomPDF = ActiveWorkbook.Path & "\" & Chemin & " " & "par" & " " & ComboBox1.Value & " " & "le" & " " & LaDate & ".pdf"
 
    If Chemin = "" Then
        MsgBox ("Vous n'avez pas importé de Nomenclature !")
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
 
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
 
    DoEvents
 
 
 
With ws
    .Activate
    .Range("A1").Select
    Application.Wait Now + TimeValue("0:00:02")
    .Paste
 
    With .PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sNomPDF, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End With
 
    Application.DisplayAlerts = False
    Sheets("IMPRIMPDF").Select
    Selection.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

Du coup, j'ai repris le code d'origine et j'y ai ajouté une tempo de 2sec.
Cela fonctionne chez moi et chez les autres, donc sujet résolut.
Je vais pouvoir m'attaquer à mon 2ème problème mais pour cela je vais ouvrir un autre poste.
Merci encore pour votre aide.