XL 2016 Macro avec imputbox

M

MickaeL_D

XLDnaute Junior
Bonjour à tous les experts,

Je souhaiterais intégrer une IMPUTBOX dans le fichier en PJ.

Si la valeur de colonne E sort de la zone verte du graphique. Obliger l'opérateur à écrire un commentaire par le biais d'une IMPUTBOX.
Puis en appuyant sur "OK" le commentaire viendrait se placer directement dans la colonne à la ligne concernée.

En espérant avoir été assez explicite,

Merci d'avance,
 

Pièces jointes

  • Test.xlsm
    16.8 KB · Affichages: 18
Solution
Bernard_XLD
Bonjour Mickael_D, le forum

Modifies le code de ton module de feuille avec le code joint, la fonction récupérera le nom de l'utilisateur.

édition pour recherche : récupérer trouver nom utilisateur username fullname

Bien cordialement, @+
VB: 
Private Function Trouver_Utilisateur$()
    Dim Compte_Utilisateur As Object
    On Error Resume Next
    Set Compte_Utilisateur = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_UserAccount.Domain='" & Environ("userdomain") & "',Name='" & Environ("username") & "'")
    If Err = 0 Then Trouver_Utilisateur = Compte_Utilisateur.FullName Else Trouver_Utilisateur = "Utilisateur inconnu"
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours...
Trier par date Trier par votes
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour Mickael_D, le forum

Voila ton fichier modifié avec une événementielle, code placé dans le module de feuille.
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:E999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:E999"))
            Do
                Cellule_en_Cours.Offset(0, 1).Value = Application.InputBox(Prompt:="Entrez un commentaire pour la valeur " & Cellule_en_Cours.Offset(0, -4).Value, Type:=2)
            Loop Until Not Cellule_en_Cours.Offset(0, 1).Value = "" And Not Cellule_en_Cours.Offset(0, 1).Value = "FAUX"
        Next Cellule_en_Cours
    End If
End Sub

Bien cordialement
 

Pièces jointes

  • Test2.xlsm
    23.4 KB · Affichages: 5
Vote positif 0 Vote négatif
M

MickaeL_D

XLDnaute Junior
Bonjour Yeahou,

Désolé pour le doublon. Mais j'ai eu un message d'erreur à la première publication :(

Merci pour cette réponse rapide. Néanmoins, il me manque une condition.
Quand je me situe entre les valeurs rentées dans les cases E5 et H5. L'IMPUTBOX ne doit pas s'activer :cool:

Merci d'avance,
 
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
pire que ça, j'ai oublié de mettre le test, faut le faire !
erreur réparée
le test est en place avec obligation de rentrer un commentaire si on n'est pas dans les valeurs
si une valeur est modifiée et revient dans la fourchette, le commentaire est relancé en modification avec suppression possible

Cordialement
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:E999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:E999"))
            If (Not (Cellule_en_Cours.Value = "") And (Cellule_en_Cours.Value < Range("H5").Value Or Cellule_en_Cours.Value > Range("E5").Value)) Or Not Cellule_en_Cours.Offset(0, 1).Value = "" Then
                Do
                    Cellule_en_Cours.Offset(0, 1).Value = InputBox(Prompt:="Entrez un commentaire pour la valeur " & Cellule_en_Cours.Offset(0, -4).Value, Default:=Cellule_en_Cours.Offset(0, 1).Value)
                Loop Until (Not Cellule_en_Cours.Offset(0, 1).Value = "" And Not Cellule_en_Cours.Offset(0, 1).Value = "FAUX") Or (Cellule_en_Cours.Value >= Range("H5").Value And Cellule_en_Cours.Value <= Range("E5").Value)
            End If
        Next Cellule_en_Cours
    End If
End Sub
 

Pièces jointes

  • Test2.xlsm
    23 KB · Affichages: 10
Vote positif 0 Vote négatif
M

MickaeL_D

XLDnaute Junior
Bonjour Yeahou,

Admettons que je veuille réalisé la même chose mais sur un champ calculé. Et, en ayant deux graphiques distincts. Comment devrais-je m'y prendre?

Merci d'avance pour ton aide,
 

Pièces jointes

  • Test2.xlsm
    21.3 KB · Affichages: 4
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Re,

on reprend le même principe sauf qu'on ira comparer une fois les cellules composantes entrées pour chaque graphique

Cordialement

code de la feuille:
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:G999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:G999"))
            If Not (Range("E" & Cellule_en_Cours.Row) = "" Or Range("F" & Cellule_en_Cours.Row) = "" Or Range("G" & Cellule_en_Cours.Row) = "") Then
                With Range("H" & Cellule_en_Cours.Row)
                    If (Not .Value = "#N/A" And (.Value < Range("G5").Value Or .Value > Range("D5").Value)) Or Not .Offset(0, 5).Value = "" Then
                        Do
                            .Offset(0, 5).Value = InputBox(Prompt:="Entrez un commentaire pour la valeur " & .Offset(0, -7).Value, Default:=.Offset(0, 5).Value)
                        Loop Until (Not .Offset(0, 5).Value = "" And Not .Offset(0, 5).Value = "FAUX") Or (.Value >= Range("G5").Value And .Value <= Range("D5").Value)
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
    If Not Intersect(Target, Range("I23:K999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("I23:K999"))
            If Not (Range("I" & Cellule_en_Cours.Row) = "" Or Range("J" & Cellule_en_Cours.Row) = "" Or Range("K" & Cellule_en_Cours.Row) = "") Then
                With Range("L" & Cellule_en_Cours.Row)
                    If (Not .Value = "" And (.Value < Range("N5").Value Or .Value > Range("K5").Value)) Or Not .Offset(0, 1).Value = "" Then
                        Do
                            .Offset(0, 1).Value = InputBox(Prompt:="Entrez un commentaire pour la valeur " & .Offset(0, -11).Value, Default:=.Offset(0, 1).Value)
                        Loop Until (Not .Offset(0, 1).Value = "" And Not .Offset(0, 1).Value = "FAUX") Or (.Value >= Range("N5").Value And .Value <= Range("K5").Value)
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
End Sub

[Fichier] -> post 11
 
Dernière édition:
Vote positif 0 Vote négatif
M

MickaeL_D

XLDnaute Junior
Bonjour Yeahou,

Dans le fichier en PJ, je souhaiterais ajouter le Username dans la colonne P. Tout cela après avoir rentré un commentaire dans la boite de dialogue.

Merci d'avance pour ton aide
 

Pièces jointes

  • Test3.xlsm
    28.8 KB · Affichages: 4
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour Mickael_D, le forum

Modifies le code de ton module de feuille avec le code joint, la fonction récupérera le nom de l'utilisateur.

édition pour recherche : récupérer trouver nom utilisateur username fullname

Bien cordialement, @+
VB: 
Private Function Trouver_Utilisateur$()
    Dim Compte_Utilisateur As Object
    On Error Resume Next
    Set Compte_Utilisateur = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_UserAccount.Domain='" & Environ("userdomain") & "',Name='" & Environ("username") & "'")
    If Err = 0 Then Trouver_Utilisateur = Compte_Utilisateur.FullName Else Trouver_Utilisateur = "Utilisateur inconnu"
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule_en_Cours As Range
    If Not Intersect(Target, Range("E23:G999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("E23:G999"))
            If Not (Range("E" & Cellule_en_Cours.Row) = "" Or Range("F" & Cellule_en_Cours.Row) = "" Or Range("G" & Cellule_en_Cours.Row) = "") Then
                With Range("H" & Cellule_en_Cours.Row)
                    If (Not .Value = "#N/A" And (.Value < Range("G5").Value Or .Value > Range("D5").Value)) Or Not .Offset(0, 5).Value = "" Then
                        Do
                            .Offset(0, 5).Value = InputBox(Prompt:="Entrez un commentaire pour la valeur " & .Offset(0, -7).Value, Default:=.Offset(0, 5).Value)
                        Loop Until (Not .Offset(0, 5).Value = "" And Not .Offset(0, 5).Value = "FAUX") Or (.Value >= Range("G5").Value And .Value <= Range("D5").Value)
                        .Offset(0, 8).Value = Trouver_Utilisateur
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
    If Not Intersect(Target, Range("I23:K999")) Is Nothing Then
        For Each Cellule_en_Cours In Intersect(Target, Range("I23:K999"))
            If Not (Range("I" & Cellule_en_Cours.Row) = "" Or Range("J" & Cellule_en_Cours.Row) = "" Or Range("K" & Cellule_en_Cours.Row) = "") Then
                With Range("L" & Cellule_en_Cours.Row)
                    If (Not .Value = "" And (.Value < Range("N5").Value Or .Value > Range("K5").Value)) Or Not .Offset(0, 1).Value = "" Then
                        Do
                            .Offset(0, 1).Value = InputBox(Prompt:="Entrez un commentaire pour la valeur " & .Offset(0, -11).Value, Default:=.Offset(0, 1).Value)
                        Loop Until (Not .Offset(0, 1).Value = "" And Not .Offset(0, 1).Value = "FAUX") Or (.Value >= Range("N5").Value And .Value <= Range("K5").Value)
                        .Offset(0, 4).Value = Trouver_Utilisateur
                    End If
                End With
            End If
        Next Cellule_en_Cours
    End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

J
  • Résolu(e)
XL 2013 Créer une macro avec un fichier pour envoyer par mail
Réponses
7
Affichages
334
TooFatBoy
TooFatBoy
C
  • Question
XL 2010 Recherche de colonne et calcul sur 2 années consécutives
Réponses
0
Affichages
211
CS49
C
M
  • Question
XL 2016 Macro avec imputbox
Réponses
1
Affichages
402
Bernard_XLD
Bernard_XLD
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
576
arnoldbrice19
A
M
  • Résolu(e)
Microsoft 365 [Résolu] Macro extraction de dates
Réponses
6
Affichages
987
maxime45
M
C
  • Question
Microsoft 365 VBA Moyennes avec conditions
Réponses
7
Affichages
596
AtTheOne
AtTheOne
M
  • Question
XL 2016 Récupérer la planification d'un excel et la croiser avec un planning d'un autre Excel
Réponses
5
Affichages
904
vgendron
vgendron
S
  • Question
XL 2019 Besoin d'aide pour macro VBA avec condition pour dupliquer ligne selon si présence d'une cellule
Réponses
4
Affichages
725
samsoun
S
M
  • Résolu(e)
XL 2016 Macro si cellules vides
2 3
Réponses
37
Affichages
3 K
fanch55
fanch55
P
  • Résolu(e)
Microsoft 365 Création planning dans Excel via Macro
Réponses
14
Affichages
1 K
ChTi160
ChTi160

Membres actuellement en ligne

5 membres et 36 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 534
Membres
112 771
dernier inscrit
mikadu49