Excel macro VB trop lente

choupichon Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention - 7 août 2014 à 13:22

Bonjour à tous,

J'ai créé un Excel pour une amie.
Cet Excel est un planning lambda où j'ai ajouté des colonnes (19) correspondant à des informations sur le client.
Dans la feuille, un certains nombre de boutons permettent de déclencher du VB et donc le remplissage de ces colonnes.
De plus, à chaque changement de cellules, les 19 colonnes à droite de la cellule sont écoutées pour remplir le tableau de boutons.
Cela permet d'avoir un seul tableau de boutons pour tout le planning

Sur mon poste, pas de soucis, mais sur le sien, ça raaaaame! :)
Ca rame tellement qu'avec le changement de cellules ça bug et remplit des colonnes sans que ce soit voulu!

Macros en fin de message

J'ai déjà remarqué que changer la valeur d'une CheckBox lançait la fonction associée.
Exemple : "ChkDent.Value = False" lance la fonction "ChkDent_Click"
Je trouve ça idiot... mais je ne vois pas comment contourner ces boucles.

Une idée pour alléger mon code?

Merci d'avance

PS :
les OB... sont des RadioButton et les Chk... sont des CheckBox.


'###############################################################################
'                           MACRO DU PATIENT - CLIC
'###############################################################################

Private Sub OBMili_Click()
    Choose_Type
End Sub

Private Sub OBGend_Click()
    Choose_Type
End Sub

Private Sub OBCiv_Click()
    Choose_Type
End Sub

Private Sub OBFam_Click()
    Choose_Type
End Sub

Private Sub Choose_Type()
    
    If OBMili.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1) = "M"
    ElseIf OBGend.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1) = "G"
    ElseIf OBFam.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1) = "F"
    ElseIf OBCiv.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1) = "C"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 1) = ""
    End If

End Sub

Private Sub ChkConsImp_Click()
    If ChkConsImp.Value Then
        ChkConsNonImp.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 2) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 2) = ""
    End If
End Sub

Private Sub ChkConsNonImp_Click()
    If ChkConsNonImp.Value Then
        ChkConsImp.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 3) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 3) = ""
    End If
End Sub

Private Sub ChkConsVetNuc_Click()
    If ChkConsVetNuc.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 4) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 4) = ""
    End If
End Sub

Private Sub ChkVMP1_Click()
    If ChkVMP1.Value Then
        ChkVMP2.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 5) = "1"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 5) = ""
    End If
End Sub

Private Sub ChkVMP2_Click()
    If ChkVMP2.Value Then
        ChkVMP1.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 5) = "2"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 5) = ""
    End If
End Sub

Private Sub ChkVMP50_Click()
    If ChkVMP50.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 6) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 6) = ""
    End If
End Sub

Private Sub ChkVMPSMR_Click()
    If ChkVMPSMR.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 7) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 7) = ""
    End If
End Sub

Private Sub ChkVSU_Click()
    If ChkVSU.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 8) = "X"
    Else
        ChkVSU50.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 8) = ""
    End If
End Sub

Private Sub ChkVSU50_Click()
    If ChkVSU50.Value Then
        ChkVSU.Value = True
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 9) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 9) = ""
    End If
End Sub

Private Sub ChkFin_Click()
    If ChkFin.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 10) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 10) = ""
    End If
End Sub

Private Sub ChkSel_Click()
    If ChkSel.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 11) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 11) = ""
    End If
End Sub

Private Sub ChkIncorp_Click()
    If ChkIncorp.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 12) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 12) = ""
    End If
End Sub

Private Sub ChkAutImp_Click()
    If ChkAutImp.Value Then
        ChkAutNonImp.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 13) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 13) = ""
    End If
End Sub

Private Sub ChkAutNonImp_Click()
    If ChkAutNonImp.Value Then
        ChkAutImp.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 14) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 14) = ""
    End If
End Sub

Private Sub ChkAutJust_Click()
    If ChkAutJust.Value Then
        ChkAutInjust.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 15) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 15) = ""
    End If
End Sub

Private Sub ChkAutInjust_Click()
    If ChkAutInjust.Value Then
        ChkAutJust.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 16) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 16) = ""
    End If
End Sub

Private Sub ChkStrepP_Click()
    If ChkStrepP.Value Then
        ChkStrepN.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 17) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 17) = ""
    End If
End Sub

Private Sub ChkStrepN_Click()
    If ChkStrepN.Value Then
        ChkStrepP.Value = False
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 18) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 18) = ""
    End If
End Sub

Private Sub ChkDent_Click()
    If ChkDent.Value Then
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 19) = "X"
    Else
        ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column + 19) = ""
    End If
End Sub

Private Sub BtnInitPatient_Click()
    OBCiv.Value = False
    OBFam.Value = False
    OBMili.Value = False
    OBGend.Value = False
    Choose_Type
    ChkConsImp.Value = False
    ChkConsNonImp.Value = False
    ChkConsVetNuc.Value = False
    ChkVMP1.Value = False
    ChkVMP2.Value = False
    ChkVMP50.Value = False
    ChkVMPSMR.Value = False
    ChkVSU.Value = False
    ChkVSU50.Value = False
    ChkFin.Value = False
    ChkSel.Value = False
    ChkIncorp.Value = False
    ChkAutImp.Value = False
    ChkAutNonImp.Value = False
    ChkAutJust.Value = False
    ChkAutInjust.Value = False
    ChkDent.Value = False
    ChkStrepP.Value = False
    ChkStrepN.Value = False
End Sub

'###############################################################################
'                           MACRO DU PATIENT - LECTURE
'###############################################################################

Sub WorkSheet_SelectionChange(ByVal Target As Range)
    Dim Colonne As Integer
    Colonne = Target.Column
    
    Dim Ligne As Integer
    Ligne = Target.Row
    

    If Colonne <= 237 Then

        ActiveSheet.Shapes("ZonePatient").TextFrame.Characters.Text = "Patient sélectionné : " & ActiveSheet.Cells(Ligne, Colonne).Value
        
        'colonne 1 : Type de personnel
        If ActiveSheet.Cells(Ligne, Colonne + 1).Value = "M" Then
            OBMili.Value = True
            OBGend.Value = False
            OBFam.Value = False
            OBCiv.Value = False
        ElseIf ActiveSheet.Cells(Ligne, Colonne + 1).Value = "G" Then
            OBGend.Value = True
            OBMili.Value = False
            OBFam.Value = False
            OBCiv.Value = False
        ElseIf ActiveSheet.Cells(Ligne, Colonne + 1).Value = "F" Then
            OBFam.Value = True
            OBMili.Value = False
            OBGend.Value = False
            OBCiv.Value = False
        ElseIf ActiveSheet.Cells(Ligne, Colonne + 1).Value = "C" Then
            OBCiv.Value = True
            OBMili.Value = False
            OBGend.Value = False
            OBFam.Value = False
        Else
            OBCiv.Value = False
            OBMili.Value = False
            OBGend.Value = False
            OBFam.Value = False
        End If
        
        'colonne 2 : consultation imputable
        If ActiveSheet.Cells(Ligne, Colonne + 2).Value = "X" Then
            ChkConsImp.Value = True
        Else
            ChkConsImp.Value = False
        End If
        
        'colonne 3 : consultation non-imputable
        If ActiveSheet.Cells(Ligne, Colonne + 3).Value = "X" Then
            ChkConsNonImp.Value = True
        Else
            ChkConsNonImp.Value = False
        End If
        
        'colonne 4 : consultation vétéran nucléaire
        If ActiveSheet.Cells(Ligne, Colonne + 4).Value = "X" Then
            ChkConsVetNuc.Value = True
        Else
            ChkConsVetNuc.Value = False
        End If
        
        'colonne 5 : durée VMP
        If ActiveSheet.Cells(Ligne, Colonne + 5).Value = "1" Then
            ChkVMP1.Value = True
            ChkVMP2.Value = False
        ElseIf ActiveSheet.Cells(Ligne, Colonne + 5).Value = "2" Then
            ChkVMP1.Value = False
            ChkVMP2.Value = True
        Else
            ChkVMP1.Value = False
            ChkVMP2.Value = False
        End If
        
        'colonne 6 : VMP >= 50ans
        If ActiveSheet.Cells(Ligne, Colonne + 6).Value = "X" Then
            ChkVMP50.Value = True
        Else
            ChkVMP50.Value = False
        End If
        
        'colonne 7 : VMP SMR
        If ActiveSheet.Cells(Ligne, Colonne + 7).Value = "X" Then
            ChkVMPSMR.Value = True
        Else
            ChkVMPSMR.Value = False
        End If
        
        'colonne 8 : VSU
        If ActiveSheet.Cells(Ligne, Colonne + 8).Value = "X" Then
            ChkVSU.Value = True
        Else
            ChkVSU.Value = False
        End If
        
        'colonne 9 : VSU >= 50ans
        If ActiveSheet.Cells(Ligne, Colonne + 9).Value = "X" Then
            ChkVSU50.Value = True
        Else
            ChkVSU50.Value = False
        End If
        
        'colonne 10 : Visite de fin de service
        If ActiveSheet.Cells(Ligne, Colonne + 10).Value = "X" Then
            ChkFin.Value = True
        Else
            ChkFin.Value = False
        End If
        
        'colonne 11 : Sélection
        If ActiveSheet.Cells(Ligne, Colonne + 11).Value = "X" Then
            ChkSel.Value = True
        Else
            ChkSel.Value = False
        End If
        
        'colonne 12 : Incorporation
        If ActiveSheet.Cells(Ligne, Colonne + 12).Value = "X" Then
            ChkIncorp.Value = True
        Else
            ChkIncorp.Value = False
        End If
        
        'colonne 13 : Autre visite : imputable
        If ActiveSheet.Cells(Ligne, Colonne + 13).Value = "X" Then
            ChkAutImp.Value = True
        Else
            ChkAutImp.Value = False
        End If
        
        'colonne 14 : Autre visite : non-imputable
        If ActiveSheet.Cells(Ligne, Colonne + 14).Value = "X" Then
            ChkAutNonImp.Value = True
        Else
            ChkAutNonImp.Value = False
        End If
        
        'colonne 15 : Autre visite : justifiées
        If ActiveSheet.Cells(Ligne, Colonne + 15).Value = "X" Then
            ChkAutJust.Value = True
        Else
            ChkAutJust.Value = False
        End If
        
        'colonne 16 : Autre visite : injustifiées
        If ActiveSheet.Cells(Ligne, Colonne + 16).Value = "X" Then
            ChkAutInjust.Value = True
        Else
            ChkAutInjust.Value = False
        End If
        
        'colonne 17 : Test strepto : positif
        If ActiveSheet.Cells(Ligne, Colonne + 17).Value = "X" Then
            ChkStrepP.Value = True
        Else
            ChkStrepP.Value = False
        End If
        
        'colonne 18 : Test strepto : negatif
        If ActiveSheet.Cells(Ligne, Colonne + 18).Value = "X" Then
            ChkStrepN.Value = True
        Else
            ChkStrepN.Value = False
        End If
        
        'colonne 19 : Consultation dentiste
        If ActiveSheet.Cells(Ligne, Colonne + 19).Value = "X" Then
            ChkDent.Value = True
        Else
            ChkDent.Value = False
        End If
    End If

End Sub

Afficher la suite

A voir également:

Excel macro VB trop lente
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Pc trop lent - Guide
Liste déroulante excel - Guide
Word et excel gratuit - Guide
Déplacer colonne excel - Guide

2 réponses

Réponse 1 / 2

skk201 Messages postés 942 Date d'inscription Statut Membre Dernière intervention 54

Bonjour

Je pense que ça serait plus simple si tu pouvais nous transmettre ton classeur via cjoint.com ou une autre plateforme de partage de fichier :)

Merci

Réponse 2 / 2

eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention 7 276

Bonjour,

Je n'ai pas trop regardé ton code. Utiliser les balises Code pour le mettre en forme.
Et surtout, comme dit skk 201, rien ne vaut un fichier.

Qq principes simples :
- dans les procédures qui ont beaucoup d'écriture sur les feuilles mettre au début :

Application.ScreenUpdating = False

- dans les passages qui déclenchent un évènement qu'on ne veut pas traiter mettre avant :

Application.EnableEvents = False
' remettre à True à la fin

eric

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Votre réponse

Discussions similaires