Probléme avec ma MsgBox

Le 28/09/2016 à 11:43

bonjour

j'ai une Msgbox qui souvre avec double clique dans laquelle j'indique un chiffre 1, 2 ou 3 qui personalise la cellule d'une couleur rouge orange ou jaune.

Si j'indique autre chose qu'un caratére numérique telque aa ab.... je perts la couleur de cellule .

exemple : si on double clique sur la cellule Z11 et que j'indique ac dans la fenetre de la box j'ai "nombre non valide" et en faisant ok puis annuler ,

auriez vous une solution pour ne pas perdre la couleur de cellule indiqué par la macro.

merci de votre aide par avance

si joint la macro et le fichier joint

philippe

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Range("D6:F7,D8:H11,I6:M11,O4:X11,Z4:AI11,B19:F21,B22:D23,B24:F35,H19:Q35,S19:AB35,AM3:AO11,AQ1:AV11,AX1:AZ11,BA2:BC11,BE3:BJ11,AF17:AK35,AM17:AR20,AN21:AR21,AM22:AR35,AT17:AY35,BA17:BF35,BH24:BJ36")) Is Nothing Then

    Dim x As Integer

    x = Application.InputBox("Choisir la gravité :" & vbCrLf & "1 = urgence structure" & vbCrLf & "2 = dommage structure" & vbCrLf & "3 = dommage caillebotis", "Choix de la gravité", Type:=1)

    If x = False Then

            If Not Application.Intersect(ActiveCell, Range("D6:F7,D8:H11,I6:M11,O4:X11,Z4:AI11,B19:F21,B22:D23,B24:F35,H19:Q35,S19:AB35")) Is Nothing Then
                ActiveCell.Interior.Color = Range("BO4").Interior.Color
                ElseIf Not Application.Intersect(ActiveCell, Range("AM3:AO11,AQ1:AV11,AX1:AZ11,BA2:BC11,BE3:BJ11,AF17:AK35,AM17:AR20,AN21:AR21,AM22:AR35,AT17:AY35,BA17:BF35,BH24:BJ36")) Is Nothing Then
                ActiveCell.Interior.Color = Range("BO5").Interior.Color
            End If

        Range("AD15").Select

    ElseIf x >= 1 And x <= 3 Then

            If x = 1 Then
                Target.Interior.ColorIndex = 3 'rouge ou = Range("BN18").Interior.Color
                ElseIf x = 2 Then
                Target.Interior.ColorIndex = 44 'orange, index couleur sur la feuille: code couleur
                ElseIf x = 3 Then
                Target.Interior.ColorIndex = 27 'jaune

            End If

    Else: MsgBox ("Le numéro demandé n'est pas attribué")

    End If
    End If

    Range("AD15").Select
End Sub
9reperes-ip-sa-revu.xlsm (164.18 Ko)
Le 28/09/2016 à 13:31

Bonjour Philippe, bonjour le forum,

To code dit clairement qui si tu cliques sur Annuler ça remet la couleur d'origine.

If x = False Then...

Modifie-le !...

Le 29/09/2016 à 09:38

Bonjour,

Je me suis sans doute mal exprimé mais le problème ne vient pas du bouton annuler.

Je voudrais en fait que lorsque l'on tape un caractère ou une chaîne de caractère tel que a ou azertyuiop, cela continue de me dire que ce n'est pas valide mais qu'on lieu de revenir à l'écran pour choisir 1, 2 ou 3, la fenêtre se ferme tout simplement sans rien modifier.

Merci d'avance

Le 29/09/2016 à 14:26

Bonjour Philippe, bonjour le forum,

Je persiste et signe... À l'ouverture de l'InputBox tu as codé pour que seules les trois options 1, 2 ou 3 soient permises. Donc si tu tapes autre chose, il te faut valider le premier message "nombre non valide" par [OK], puis impérativement cliquer sur [Annuler] si u veux sortir. Comme tu as codé pour supprimer la couleur avec If x = False (=> bouton [Annuler]), ben ça fait ce que tu as demandé de faire. Ça enlève la couleur...

Il te faut revoir tes codes. Soit tu ajoutes dans les conditions une condition texte soit tu modifies le code If x = False...

Si j'ai bien compris ça donnerait un code de ce style :

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim PLG As Range
Dim PL1 As Range
Dim PL2 As Range
Dim x As Variant

Set PLG = Range("D6:F7,D8:H11,I6:M11,O4:X11,Z4:AI11,B19:F21,B22:D23,B24:F35,H19:Q35,S19:AB35,AM3:AO11,AQ1:AV11,AX1:AZ11,BA2:BC11,BE3:BJ11,AF17:AK35,AM17:AR20,AN21:AR21,AM22:AR35,AT17:AY35,BA17:BF35,BH24:BJ36")
Set PL1 = Range("D6:F7,D8:H11,I6:M11,O4:X11,Z4:AI11,B19:F21,B22:D23,B24:F35,H19:Q35,S19:AB35")
Set PL2 = Range("AM3:AO11,AQ1:AV11,AX1:AZ11,BA2:BC11,BE3:BJ11,AF17:AK35,AM17:AR20,AN21:AR21,AM22:AR35,AT17:AY35,BA17:BF35,BH24:BJ36")
If Not Intersect(Target, PLG) Is Nothing Then
    x = Application.InputBox("Choisir la gravité :" & vbCrLf & "1 = urgence structure" & vbCrLf & "2 = dommage structure" & vbCrLf & "3 = dommage caillebotis", "Choix de la gravité")
    Select Case x
        Case Is = False
            If Not Application.Intersect(ActiveCell, PL1) Is Nothing Then ActiveCell.Interior.Color = Range("BO4").Interior.Color
            If Not Application.Intersect(ActiveCell, PL2) Is Nothing Then ActiveCell.Interior.Color = Range("BO5").Interior.Color
        Case 1
            Target.Interior.ColorIndex = 3 'rouge ou = Range("BN18").Interior.Color
        Case 2
            Target.Interior.ColorIndex = 44 'orange, index couleur sur la feuille: code couleur
        Case 3
            Target.Interior.ColorIndex = 27 'jaune
        Case Else
            If MsgBox("Nombre non valide ! Voulez vous continuer malgré tout ?", vbYesNo, "ATTENTION") = vbYes Then Target.Value = x
    End Select
End If
Range("AD15").Select
End Sub
Le 29/09/2016 à 14:59

Merci ThauThème c'est exactement ce que je recherchais, t'es un as

Rechercher des sujets similaires à "probleme msgbox"