XL 2016 Macro avec imputbox

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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

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
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

Vote positif 0 Vote négatif
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 😎

Merci d'avance,
 
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Question Question
XL 2016 Macro avec imputbox
Réponses
1
Affichages
433
Bernard_XLD
Bernard_XLD
C
  • Question Question
Microsoft 365 VBA Moyennes avec conditions
Réponses
7
Affichages
704
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2016 Macro si cellules vides
2 3
Réponses
37
Affichages
3 K
fanch55
fanch55
surgeon84fr
  • Question Question
XL 2016 Macro VBA pour créer une BdD à partir de plusieurs fichiers
Réponses
2
Affichages
2 K
surgeon84fr
surgeon84fr
L
  • Résolu(e)
XL 2016 Macro VBA - Envoi mail automatique selon plusieurs échéances
Réponses
5
Affichages
5 K
LuanaDDC
L
Y
  • Question Question
XL 2016 Macro- Gestion projet
Réponses
1
Affichages
1 K
ynx69
Y
Undersound
  • Question Question
XL 2016 VBA Comparer fichier traité avec l'original remplissage des cellules avec couleurs pour révision
Réponses
2
Affichages
1 K
Dim.Reichart
D
surgeon84fr
  • Question Question
VBA scinder un fichier en plusieurs
Réponses
6
Affichages
1 K
surgeon84fr
surgeon84fr
A
  • Question Question
Formule copie d'une ligne en fonction d'une chaîne de caractère spécifique
Réponses
3
Affichages
912
arj
A
A
  • Question Question
Pb VBA Macro Liste/ filtres 4 critères de sélection
Réponses
3
Affichages
1 K
Arno
A
F
  • Question Question
Créer un graphique avec une macro VBA
Réponses
7
Affichages
2 K
jep77
jep77
A
  • Question Question
Planning pour 3 usines avec une feuille DATA, Macro nécessaire?
Réponses
7
Affichages
1 K
ChTi160
ChTi160
chris6999
  • Question Question
Macro de type filtre "contient" pour sélectionner les lignes contenant un mot clé
2
Réponses
15
Affichages
12 K
BOISGONTIER
BOISGONTIER
S
  • Question Question
macro avec de multiples conditions (alors que je sais que je n'ai pas le niveau)
Réponses
14
Affichages
2 K
syl
S
K
  • Question Question
Sommeproduit en vba
Réponses
11
Affichages
1 K
kheldar
K
H
  • Question Question
VBA - Graphique : ajouter le total sur barres empilées
Réponses
1
Affichages
5 K
haleakala
H
M
[REF] Wiki 6 de MichelXld (Doublons, Tris, Filtres, Variables, Fichiers fermés, Acces
Réponses
0
Affichages
69 K
MichelXld
M
Retour