Macro "gèle" Excel

**isrdum** · 29/10/2014, 19h20

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

**Stef999** · 29/10/2014, 22h44

Bonjour,

Ça n'a peut être rien à voir mais pourquoi ces lignes avec un Call ?

Code :

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

1
2
3
4
5
Private Sub CommandButton1_Click()
    Call Feuil6.Activate
End Sub
Private Sub CommandButton11_Click()
    Call Feuil9.Activate

**isrdum** · 30/10/2014, 13h14

merci pour le tuyau, sans savoir pourquoi, j'ai pris l'habitude de mettre la commande "call" avant un .activate....

Mais comme tu le supposais, après avoir effectué la correction de mes pages, je demeure coincé avec le même problème.

**parmi** · 31/10/2014, 13h42

Bonjour,

Est-ce que tu sais où se situe le problème ?
Si tu roules ton programme en pas à pas, est-ce que ça fonctionne bien ?

**isrdum** · 31/10/2014, 14h30

Bonjour

Non, j'ignore où est le problème
Le programme en tant que tel fonctionne très bien, mais on dirait qu'Excel sature et qu'il n'arrive plus à afficher le contenu correctement, ce qui fait "crasher" Excel. Je dois alors redémarrer le Excel et le redémarrer. Le "crash" survient lorsque je passe d'une page à l'autre. Au total, j'en ai une vingtaine. De la première à la deuxième tout va bien, c'est lorsque j'arrive à la douzième qu'il y a une sorte de superposition des images de deux pages distinctes. J'ai vérifié l'utilisation de la mémoire et du processeur et le problème ne semble pas provenir de là (j'ai 4 go de RAM et un i5 quadcore). Je me suis fait proposé de fractionner mon programme en de multiples petits programmes moins lourds. J'espère que ce sera suffisant pour régler mon problème. Mais l'idéal serait "d'Alléger" mon programme pour permettre à Excel de le supporter.

P.S. J'ai fait des test avec Excel 2010 et 2013 sans résultats.

**parmi** · 31/10/2014, 15h26

D'après moi, le problème se situe au niveau de la mémoire graphique, mais je peux me tromper.
Il semble y avoir pas mal de contrôles sur les feuilles, ce qui ralentit passablement les traitements.
Est-ce que ce sont des contrôles ActiveX ou Formulaire ?

**isrdum** · 31/10/2014, 17h32

Merci de t'attarder à mon problème!!!

Oui, comme tu le dis, il y a beaucoup de contrôle qui sont tous des ActiveX

Au final, avec les bouton et boutontradio, il devrait y en avoir plus de 5000!!!!!

Y'a peut-être carrément le choix du programme utilisé qui est une erreur, considérant qu'Excel est un chiffrier au départ.

**parmi** · 31/10/2014, 18h02

5000 contrôles, c'est certain qua ça ralentit beaucoup un programme...
Peut-être pourrais-tu revoir le principe.

Par exemple, sur Double-Click d'une cellule dans la plage voulue, tu mets/enlèves un "X" et tu n'as plus ces boutons-radios.
La même chose pourrait être effectuée avec les cases à cocher.
Une idée comme ça...

**clementmarcotte** · 31/10/2014, 21h15

Bonjour,

Envoyé par parmi

5000 contrôles, c'est certain qua ça ralentit beaucoup un programme...

Et surtout que 5000 contrôles, cela demande beaucoup de mémoire et de ressources-système. À moins que cela soit changé depuis la "refonte" qui a amené Excel 2007; on m'a toujours dit qu'Excel avait absolument besoin de l'ensemble du classeur en mémoire vive, pour travailler comme du monde.

Comme de plus en plus de programmes "imposent" un service de vérification automatique des mises-à-jour en permanence en mémoire et toutes sortes de démarrages automatiques pour 36 raisons, la mémoire vive disponible peut "descendre" très vite.

**isrdum** · 03/11/2014, 16h12

Bonjour parmi et clementmarcotte

J'ai une petite question pour vous (et évidemment à toute la communauté de ce site aussi)

Pour pallier à mon problème de "mémoire RAM" j'ai décidé de fractionner mon programme en une multitude de petits programmes.

Pour naviguer d'une page excel à l'autre j'utilise désormais la commande

Code :

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

Workbooks.Open Filename:="C:\XYZ"

Jusque là rien de sorcier

Là où ça se complique, c'est dans la vérification de l'état d'une page (fermée ou ouverte)

Ainsi, lorsque l'utilisateur veut ouvrir un nouveau programme, j'aimerais que mon programme vérifie s'il est déjà ouvert. Si c'est le cas, il ne ferait que l'afficher, et s'il est fermé, il l'ouvrirait. De cette manière, j'éviterais l'affichage du message d'erreur lorsqu'une page est déjà ouverte et que l'utilisateur demande son ouverture!!!

Suis-je suffisamment clair....

Voici une tentative infructueuse

Code :

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

1
2
3
4
5
6
7
Sub CommandButton3_Click()
If WorkbookOpen("C:\Programme MAUAP\Menu MAUAP.xlsm") Then
    ThisWorkbook.Sheets("C:\Programme MAUAP\Menu MAUAP.xlsm").Activate
    Else
        Workbooks.Open "C:\Programme MAUAP\Menu MAUAP.xlsm"
    End If
 End Sub

Merci

**kiki29** · 03/11/2014, 16h41

Salut, voir Code pour vérifier si un fichier est déjà ouvert
Extrait :

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
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
 
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
 
On Error Resume Next       ' Turn error checking off.
filenum = FreeFile()       ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
 
    ' Check to see which error occurred.
    Select Case errnum
 
            ' No error occurred.
            ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False
 
            ' Error number for "Permission Denied."
            ' File is already opened by another user.
        Case 70
            IsFileOpen = True
 
            ' Another error occurred.
        Case Else
            Error errnum
    End Select
 
End Function

**parmi** · 03/11/2014, 16h49

Pour vérifier si un programme est ouvert, j'y vais ainsi, mais il peut y avoir d'autres méthodes.

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
'.....
    If Not IsOpen(NomFichier) Then
        Workbooks.Open Fichier
    Else
        Windows(NomFichier).Activate  'si on veut l'afficher
    End If
'.....
 
Function IsOpen(Fichier As String) As Boolean
    Dim Fenetre As Window
 
    For Each Fenetre In Windows
        If Fenetre.Caption = Fichier Then
            IsOpen = True
            Exit Function
        End If
    Next
End Function

Si c'est pour vérifier si le fichier est en lecture seule,
If MonFichier.ReadOnly then 'il est en lecture seule

**isrdum** · 03/11/2014, 16h53

Envoyé par kiki29

Salut, voir ici

Merci kiki29

J’avais déjà essayé ce programme
Voici ce que j'obtiens comme résultat

**isrdum** · 03/11/2014, 17h04

SUPER.... SIMPLEMENT SUBLIME.... Une gros merci parmi

Envoyé par parmi

Pour vérifier si un programme est ouvert, j'y vais ainsi, mais il peut y avoir d'autres méthodes.

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
'.....
    If Not IsOpen(NomFichier) Then
        Workbooks.Open Fichier
    Else
        Windows(NomFichier).Activate  'si on veut l'afficher
    End If
'.....
 
Function IsOpen(Fichier As String) As Boolean
    Dim Fenetre As Window
 
    For Each Fenetre In Windows
        If Fenetre.Caption = Fichier Then
            IsOpen = True
            Exit Function
        End If
    Next
End Function

Si c'est pour vérifier si le fichier est en lecture seule,
If MonFichier.ReadOnly then 'il est en lecture seule

**kiki29** · 03/11/2014, 17h28

Salut, si tu n'es pas capable de résoudre ce genre de pb : "Sub ou Fonction non définie" ( B A BA programmation ) j'ai des doutes pour le reste.

**isrdum** · 04/11/2014, 16h13

Encore moi!!!!

J'ai encore besoin de votre aide chers Pro de VBA

Donc mon projet est constitué de multiples petits programmes

Pour ne pas surcharger la mémoire, je veux que lors qu'un nouveau programme est sélectionné, le précédent soit automatiquement fermé (la personne navigue via des boutons).

J'ai écris deux codes qui ne fonctionnent pas bien:

Code :

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

1
2
3
4
5
Private Sub CommandButton3_Click()
        Workbooks.Open "C:\Programme MAUAP\Dossiers\Milieu piétonnier.xlsm"
        Sheets("Sous-menu milieu piétonnier").Activate
        ActiveWorkbook.Close savechanges:=True
End Sub

Celui-ci ouvre le nouveau programmes, mais comme la commande ActiveWorkBook est placé après la commande d'ouverture, il ferme le nouveau programme plutôt que l'ancien

Code :

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

1
2
3
4
5
Private Sub CommandButton3_Click()
        ActiveWorkbook.Close savechanges:=True        
        Workbooks.Open "C:\Programme MAUAP\Dossiers\Milieu piétonnier.xlsm"
        Sheets("Sous-menu milieu piétonnier").Activate
End Sub

Dans cette situation, le programme est fermé directement sans que la commande ActiveWorkBook puisse être activée!!!!

Quoi faire???

Merci

**parmi** · 04/11/2014, 16h28

Déclares des variables-objets Workbook pour te situer.

Code :

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

1
2
3
4
5
6
7
Dim CurBook As Workbook, NewBook As Workbook
Set Curbook = ThisWorkbook  'le classeur avec les macros de départ
Workbooks.Open "TonFichier.xlsm"
Set NewBook = ActiveWorkbook
'... code de traitement
'Pour fermer
NewBook.Close True  'si c'est bien celui que tu veux fermer

**isrdum** · 04/11/2014, 16h35

Merci parmi, mais ton code se comporte exactement comme celui-ci

Code :

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

1
2
3
4
5
Private Sub CommandButton3_Click()
        Workbooks.Open "C:\Programme MAUAP\Dossiers\Milieu piétonnier.xlsm"
        Sheets("Sous-menu milieu piétonnier").Activate
        ActiveWorkbook.Close savechanges:=True
End Sub

Par conséquent, dans le menu, lorsque je clique sur un bouton qui appel un nouveau programme, le processus de loading se déclenche et avant que le nouveau programme soit affiché, il s’éteint aussitôt, me laissant seul avec le menu. Alors que c'est le menu que je veux qui disparaisse!!

Je m'étais peut-être mal exprimé dans le précédant message!!

**isrdum** · 04/11/2014, 16h38

Super!!! Ça marche, j'ai simplement modifié une donnée dans ton code

Code :

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

1
2
3
4
5
6
7
Dim CurBook As Workbook, NewBook As Workbook
Set Curbook = ThisWorkbook  'le classeur avec les macros de départ
Workbooks.Open "TonFichier.xlsm"
Set NewBook = ActiveWorkbook
'... code de traitement
'Pour fermer
CurBook.Close True  'si c'est bien celui que tu veux fermer

SUPER parmi, tu es formidable!!!

Macro "gèle" Excel [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager