Userform - Microsoft Excel a cessé de fonctionner

Version imprimable

Bonjour,

Alors voilà je suis encore débutante sur VBA malgré que j'apprenne beaucoup en passant par developpez.net. Dès que je bloque et jusqu'à présent j'ai toujours fini par trouver une réponse à chacun de mes problèmes… Jusqu'à aujourd'hui :?
Je ne sais pas trop par où commencer pour expliquer mon problème car en réalité je n’ai absolument aucune idée d’où ça vient alors je vais commencer par le début peut-être ^^
Je travaille sur un logiciel de suivi de contrôles et nous devons référencer les contrôles de toutes les entités de l'entreprise worldwide en un minimum de temps. Il est possible de le faire par import cependant pour les utilisateurs ne connaissant ni le logiciel et encore moins le formalisme du fichier d'import j'ai créé un fichier plus "sexy" afin que ça leur parle et en des termes métier "Risque et contrôle permanent". Dans la première version pas de VBA.
Pour importer les contrôles il est nécessaire de définir un scope (organisation géographique, entités, processus, etc.) . Dans le fichier d’import le fil d’Ariane est repris, s’il y a plusieurs codes pour un champ alors chaque fil d’Ariane est séparé du symbole « | ».
Dans cette première version nous avions décidé de limiter l'ajout des codes à un seul par champ car c’était trop fastidieux pour eux et à mettre en place pour nous… seulement depuis la diffusion du fichier certains utilisateurs nous ont signalé qu'ils aimeraient avoir la possibilité d’ajouter plusieurs codes… Ça c’était l’intro :D

Dans la nouvelle version du fichier que je travaille voilà le code VBA de la feuille ‘Controls’ :
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 68 69 70 71 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim plage1 As Range Dim plage2 As Range Dim plage3 As Range Dim plage4 As Range Dim plage5 As Range Dim plage6 As Range Set plage1 = Range("G6:G1250") Set plage2 = Range("H6:H1250") Set plage3 = Range("I6:I1250") Set plage4 = Range("J6:J1250") Set plage5 = Range("K6:K1250") Set plage6 = Range("N6:N1250") Worksheets("Feuil1").Range("A3:B7").Clear Worksheets("Feuil1").Range("A11:B15").Clear Worksheets("Feuil1").Range("A19:B23").Clear Worksheets("Feuil1").Range("A27:B31").Clear Worksheets("Feuil1").Range("A35:B39").Clear Worksheets("Feuil1").Range("A43:B47").Clear Worksheets("Feuil1").Range("C2").Clear Worksheets("Feuil1").Range("C10").Clear Worksheets("Feuil1").Range("C18").Clear Worksheets("Feuil1").Range("C26").Clear Worksheets("Feuil1").Range("C34").Clear Worksheets("Feuil1").Range("C42").Clear If Not Application.Intersect(Target, plage1) Is Nothing Then UserForm1.Show Target = Worksheets("Feuil1").Range("C2") Application.SendKeys "{Esc}" End If If Not Application.Intersect(Target, plage2) Is Nothing Then UserForm2.Show Target = Worksheets("Feuil1").Range("C10") Application.SendKeys "{Esc}" End If If Not Application.Intersect(Target, plage3) Is Nothing Then UserForm3.Show Target = Worksheets("Feuil1").Range("C18") Application.SendKeys "{Esc}" End If If Not Application.Intersect(Target, plage4) Is Nothing Then UserForm4.Show Target = Worksheets("Feuil1").Range("C26") Application.SendKeys "{Esc}" End If If Not Application.Intersect(Target, plage5) Is Nothing Then UserForm5.Show Target = Worksheets("Feuil1").Range("C34") Application.SendKeys "{Esc}" End If If Not Application.Intersect(Target, plage6) Is Nothing Then UserForm6.Show Target = Worksheets("Feuil1").Range("C42") Application.SendKeys "{Esc}" End If End Sub
La Feuil1 est une feuille intermédiaire qui va chercher le fil d’ariane des codes saisis dans les userform via un recherchev (j’ai pas trouvé mieux^^)
Ci-dessous un extrait du code du userform1 sachant que le bug arrive après avoir cliqué sur Save, le fil d’ariane est bien repris dans la cellule mais j‘ai le message d’erreur et excel redémarre… Cela se passe sur certains userform et pas sur d’autres… Encore plus bizarre, je n’ai pas le bug sur une autre feuille qui utilise aussi le userfom1…
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 AddEntity1_Click() If entityLevel1.Value = "BU" Then entity1.Caption = "BU_" & entityCode1 Else If entityLevel1.Value = "EFU" Then entity1.Caption = "EFU_" & entityCode1 End If End If entity1.Visible = True If entityLevel1.Value = "" Or entityCode1.Value = "" Then MsgBox "Both fields are mandatory" Else If Worksheets("Feuil1").Range("C3").Text = "#N/A" Then MsgBox "The entity does not exist in Contrast, please check you have entered the good code or contact the Contrast support team" AddSecondEntity.Visible = False Else BreadcrumbTrail.Visible = True BreadcrumbTrail.Value = Worksheets("Feuil1").Range("C3").Text AddSecondEntity.Visible = True End If End If End Sub Private Sub Save_Click() Unload Me End Sub Private Sub AddEntity2_Click() If entityLevel2.Value = "BU" Then entity2.Caption = "BU_" & entityCode2 Else If entityLevel2.Value = "EFU" Then entity2.Caption = "EFU_" & entityCode2 End If End If entity2.Visible = True If entityLevel2.Value = "" Or entityCode2.Value = "" Then MsgBox "Both fields are mandatory" Else If Worksheets("Feuil1").Range("C4").Text = "#N/A" Then MsgBox "The entity does not exist in Contrast, please check you have entered the good code or contact the Contrast support team" AddThirdEntity.Visible = False Else BreadcrumbTrail.Visible = True BreadcrumbTrail.Value = Worksheets("Feuil1").Range("C3").Value & "|" & Worksheets("Feuil1").Range("C4").Value AddThirdEntity.Visible = True End If End If End Sub
Je ne sais pas si tout est très clair sans le fichier mais je donnerai toutes les informations nécessaires pour pouvoir résoudre ce problème.
J'ai conscience que mon code peut être largement amélioré mais étant encore novice je n'ai pas toute la connaissance pour le faire...

Un grand merci par avance pour votre aide :roll:
Aline

re
bonjour j'ait fait un peu de menage dans ton 1er code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim plage(6) As Range,cible ,i as long ,usf as object
    With Worksheets("Feuil1")
        Set plage(1) = .Range("G6:G1250")
        Set plage(2) = .Range("H6:H1250")
        Set plage(3) = .Range("I6:I1250")
        Set plage(4) = .Range("J6:J1250")
        Set plage(5) = .Range("K6:K1250")
        Set plage(6) = .Range("N6:N1250")
        .Range("A3:B7, A11:B15, A19:B23, A27:B31, A35:B39, A43:B47, C2, C10, C18, C26, C34, C42").Clear
        cible = Array(, "C2", "C10", "C18", "C26", "C34", "C42")
        For i = 1 To 6
            If Not Application.Intersect(Target, plage(i)) Is Nothing Then
                .Range(cible(i)).Activate
                'Target = Worksheets("Feuil1").Range(cible(i))'c'est pas putot la ligne du dessus que tu veux faire?????
                Set usf = Switch(i = 1, UserForm1, i = 2, UserForm2, i = 3, UserForm3, i = 4, UserForm4, i = 5, UserForm5, i = 6, UserForm6)'on choisi quel userform selon la plage d'intersection 
                usf.Show
            End If
            'Application.SendKeys "{Esc}"'je comprends pas tres bien a quoi te sert ce send keys ???????
        Next
    End With
End Sub

;)

14/05/2018, 17h10
Aline75

Merci beaucoup pour ce premier retour!!!
Je vais regadrer de plus près tout ça et je reviens :D:lol:
14/05/2018, 17h25
Aline75

Citation:

Envoyé par Aline75

'Target = Worksheets("Feuil1").Range(cible(i))'c'est pas putot la ligne du dessus que tu veux faire?????

Pour répondre à cette question déjà, en fait je veux que dans la cellule où j'ai double cliqué depuis la feuille 'Controls' ça prenne la valeur en 'Feuil1' de la cellule C2 pour usf1, C10 pour usf2, C18 pour usf3, C26 pour usf4, C34 pou usf5 et C42 pour usf6. C'est ici qu'est calculé le fil d'ariane.

Citation:

Envoyé par Aline75

'Application.SendKeys "{Esc}"'je comprends pas tres bien a quoi te sert ce send keys ???????

J'avais trouvé cette méthode car sinon une fois le userform fermé, le fil d'ariane bien repris dans la cellule "target" j'étais systématiquement en mode saisie...
14/05/2018, 17h33
Aline75

Ben écoute tout fonctionne j'ai adapté 2/3 trucs mais tu me sauves clairement!!! Non seulement ça fonctionne maintenant mais en plus mon code est beaucoup plus court et LISIBLE :D

Comme c'est la première fois je ne sais pas comment voter par contre tu peux m'indiquer? je like ton message en bas à droite c'est ça???
merci encore
14/05/2018, 17h53
patricktoulon

re

re
oui c'est ca
mais je pense encore que pour cette partie on pourrait encore simplifier
17/05/2018, 10h02
Aline75

Bonjour Patrick,

Effectivement il y a surement encore à améliorer d'autant plus que si le message "Microsoft a cessé de fonctionner" ne s'affiche plus depuis mon ordinateur... il est toujours présent lorsque je teste depuis les ordinateurs de mes collegues :?

Aussi je ne sais pas si la boucle For est la bonne solution pour ce que je cherche à faire. Les utilisateurs du fichier devront pouvoir passer d'une colonne à l'autre peu importe l'ordre et même s'il faut repasser par une colonne ils doivent pouvoir le faire... En fonction des manip que je fais souvent ca fait "bugger" ma macro au niveau du Next :roll:

Merci encore pour ton aide
ps: je ne pourrai pas me reconnecter avant mercredi mais je me reconnecterai à la première heure :D
23/05/2018, 09h58
Aline75

Aucune piste pour résoudre mon problème? :oops::(
06/06/2018, 16h14
Aline75

Toujours aucune réponse pour moi? :(:(:(