Discussion :

[isrdum]

Bonjour

J'ai construit une macro relativement simple dans le cadre d'un travail qui se répète sur une trentaine de fois sur différentes pages



Essentiellement, le programme permet d'évaluer des services offert

Lorsque je navigue d'une page à l'autre avec les boutons "Page suivante" après quelques clicks, Excel "freeze" et je dois fermer le programme via "Ctrl - Alt - Del" pour pouvoir l'arrêter.

En fait, c'est comme si deux pages étaient chargées en même temps (elle se superposent)

J'ai vérifié la mémoire consommé et il me reste 2Go de libre sur mon Ordi sur un total de 4 Go, donc le problème ne semble pas provenir de là

D'une page à l'autre, le programme est très similaire

Voici le programme de l'image que j'ai accolé à mon message

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Private Sub Worksheet_Activate()
    If Dir("C:\Images MAUAP\Milieu piétonier\Équipement contrôle", vbDirectory) <> "Équipement contrôle" Then
        MkDir ("C:\Images MAUAP\Milieu piétonier\Équipement contrôle")
    End If
End Sub
 
Private Sub CommandButton3_Click()
    Call Feuil2.Activate
End Sub
Private Sub CommandButton2_Click()
    Call Feuil3.Activate
End Sub
Private Sub CommandButton7_Click()
    Range("E14:E72").ClearContents
End Sub
Private Sub CommandButton8_Click()
    Range("I14:I72").ClearContents
End Sub
Private Sub CommandButton1_Click()
    Call Feuil6.Activate
End Sub
Private Sub CommandButton11_Click()
    Call Feuil9.Activate
End Sub
Private Sub CommandButton4_Click()
    Dim NomPicture As String
    Dim Picture1 As Variant
    On Error GoTo ErrMsg
    ChDrive "C"
    ChDir "C:\Images MAUAP\Milieu piétonier\Équipement contrôle"
    Picture1 = Application.GetSaveAsFilename( _
        FileFilter:="Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP", _
        Title:="Sélectionnez une image à sauvegarder")
    NomPicture = Right(Picture1, Len(Picture1) - InStrRev(Picture1, "\"))  'trouve le nom du fichier
    FileCopy Picture1, "C:\Images MAUAP\Milieu piétonier\Équipement contrôle\" & NomPicture  'Copie du fichier dans l'autre emplacement
Exit Sub
ErrMsg:
    MsgBox ("Vous n'avez pas sauvegardé d'image"), , "Error"
End Sub
Private Sub CommandButton5_Click()
    Dim Picture1 As Variant
    Dim pic As Object
    Dim rng As Range
    Dim rng2 As Range
    Dim MyPath As String
    Application.ScreenUpdating = False
    Set rng = Range("B18")
    Set rng2 = Range("A1", rng.Offset(-1, -1))
    ChDrive "C"
    ChDir "C:\Images MAUAP\Milieu piétonier\Équipement contrôle"
    Picture1 = Application.GetOpenFilename( _
        FileFilter:="Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP", _
        Title:="Sélectionnez une image")
    On Error GoTo ErrMsg
    With Range("A1", rng.Offset(-1, -1))
        Set pic = ActiveSheet.Shapes.AddPicture(Picture1, False, True, _
            .Width, .Height, 600, 600)
    End With
    With pic
        .LockAspectRatio = msoFalse
    End With
    Application.ScreenUpdating = True
Exit Sub
ErrMsg:
    MsgBox ("Vous n'avez pas chargé d'image"), , "Error"
End Sub
Private Sub CommandButton6_Click()
        MsgBox "Les planchers/allées d’un parcours sans obstacle présentant une pente supérieure à 1 :20 doivent respecter les spécifications techniques appliquées aux rampes (GPAU 30)" & Chr(10) & "" & Chr(10) & "Toujours envisager la construction de rampe avec les escaliers (Transports Québec 2007)" & Chr(10) & "" & Chr(10) & "Favoriser les dénivellations en rampes plutôt qu’en escaliers, dans la mesure du possible en pente douce de 1:20 ou au maximum de 1:12, pour l’accessibilité et l’entretien. Opter pour les pentes les plus douces possibles pour réduire l’effort à fournir pour les franchir (GPAU 72)", , "Informations générales"
End Sub
Private Sub CommandButton10_Click()
        MsgBox "Les critères qui sont encadrés dans une bordure foncée signifie que ce sont des éléments clés de la construction" & Chr(10) & "" & Chr(10) & "Par conséquent, pour que la structure considérée soit praticable, cet éléments doit absolument être respecté", , "Éléments clé"
End Sub
Private Sub CommandButton9_Click()
    Dim j As Integer
    Dim Z As Integer
    For j = 1 To 7
    Z = j * 4
        If Me.OLEObjects("OptionButton" & Z).Object.Value = False Then
        Me.OLEObjects("OptionButton" & Z).Object.Value = True
        End If
    Next j
End Sub
Private Sub CommandButton12_Click()
    MsgBox "Ministère de l'écologie et al., 2008", , "Référence"
End Sub
Private Sub CommandButton13_Click()
    MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton14_Click()
    MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton15_Click()
    MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton16_Click()
    MsgBox "CSA: 8.3.7.2", , "Référence"
End Sub
Private Sub CommandButton17_Click()
    MsgBox "GPAU 82", , "Référence"
End Sub