une aide pour "fusionner ces codes

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
zesuila

zesuila

XLDnaute Occasionnel
Bonjour à tous
Voilà , grâce aux excelliens de ce site , j'ai pu bidouiller un petit programme.
Mais là je coince :
ce code permet lorsque un des choix est proposé d'ouvrir automatiquement la fenêtre des commentaires

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
If InStr("DIVERS HORS PAO AUTRES DEMANDE PAO ", Target) > 0 Then
If Target.Comment Is Nothing Then
Target.AddComment ' Création commentaire
Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
Target.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Bold"
SendKeys "+{F2}"
End If
End If
End If
End Sub


puis j'ai ce second code qui lui me permet d'extraire ces commentaires et de les mettre dans une colonne précise


Sub Extrait()

For Each C In Range("A3", [A65000].End(xlUp))
C.Offset(0, 32) = C.Comment.Text
Next C
End Sub

(merci encore à jacques Boisgontier)

Ce que je souhaiterai c'est de compiler les deux c'est à dire faire le 1er code puis le second dans la même foulée.

A vous de jouer😎

merci
 
Trier par date Trier par votes
Re : une aide pour "fusionner ces codes

Bonjour Zesuila,

Essaye peut-être comme ça
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
    If InStr("DIVERS HORS PAO AUTRES DEMANDE PAO ", Target) > 0 Then
      If Target.Comment Is Nothing Then
        Target.AddComment  ' Création commentaire
        Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
        Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
        Target.Comment.Shape.OLEFormat.Object.Font.FontSty le = "Bold"
        SendKeys "+{F2}"
        ' Ici
        Target.Offset(0, 32) = Target.Comment.Text
      Else
        ' ou là
        Target.Offset(0, 32) = Target.Comment.Text
      End If
    End If
  End If
End Sub

A+
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

bonjour et merci de ton aide

j'ai donc essayé, mais cela ne fonctionne pas bien ! lorsque j'ai choisi un des choix, par exemple en A3 et que j'ai rempli le commentaire, rien ne se passe en colonne 32.
Par contre si je reprends le même choix, donc en A3, cette fois ci le commentaire se place bien en colonne 32.😕
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

bonjour tuesla

A tester:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
 If InStr("DIVERS,HORS,PAO,AUTRES,DEMANDE,PAO", Target) > 0 Then
   If Target.Comment Is Nothing Then
      Target.AddComment ' Création commentaire
      Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
      Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
      Target.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Bold"
      Target.Comment.Text "Iléla"
   End If
   Target.Offset(0, 2) = Target.Comment.Text
 End If
End If
End Sub
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

pierrejean à dit:
bonjour tuesla

A tester:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
 If InStr("DIVERS,HORS,PAO,AUTRES,DEMANDE,PAO", Target) > 0 Then
   If Target.Comment Is Nothing Then
      Target.AddComment ' Création commentaire
      Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
      Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
      Target.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Bold"
      Target.Comment.Text "Iléla"
   End If
   Target.Offset(0, 2) = Target.Comment.Text
 End If
End If
End Sub
Cliquez pour agrandir...


Bonjour
mais n'est ce pas le même code que ci dessus mis à part le (0,2) au lieu de (0, 32) ?
de plus les commentaires sont différents je fais referece à ta ligne Target.Comment.Text "Iléla"
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

Re,

Alors essaye peut-être ceci
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
    If InStr("DIVERS HORS PAO AUTRES DEMANDE PAO ", Target) > 0 Then
      If Target.Comment Is Nothing Then
        Target.AddComment  ' Création commentaire
        Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
        Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
        Target.Comment.Shape.OLEFormat.Object.Font.FontStyle = "Bold"
        SendKeys "+{F2}"
      End If
    End If
    If Target.Comment.Text <> "" Then
      Target.Offset(0, 32) = Target.Comment.Text
    End If
  End If
End Sub

A+
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

Re
Je explique mon code:

Si le commentaire n'existe pas il est créé avec un debut (Iléla mais tu peux evidemment choisir autr chose ) c'est ce que faisait ton 1er code avec Sendkeys mais en sus il le reporte dans la cellule (0,2) (ou cellule(0,32) si tu preferes
Par contre il est vrai que seule la cellule modifiée subit ce traitement
Si tu veux rafraichir toutes les cellules le mieux est d'appeler ta seconde macro ce qui donnerait:

A tester
Code: 
If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
If InStr("DIVERS HORS PAO AUTRES DEMANDE PAO ", Target) > 0 Then
If Target.Comment Is Nothing Then
Target.AddComment ' Création commentaire
Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
Target.Comment.Shape.OLEFormat.Object.Font.FontSty le = "Bold"
SendKeys "+{F2}"
End If
End If
End If
[COLOR=blue]Call Extrait
[/COLOR]End Sub
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

est-ce tu veux dire que le code suivant ne fait rien ...

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A2:A20], Target) Is Nothing And Target.Count = 1 Then
If InStr("DIVERS HORS PAO AUTRES DEMANDE PAO ", Target) > 0 Then
If Target.Comment Is Nothing Then
Target.AddComment ' Création commentaire
Target.Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
Target.Comment.Shape.OLEFormat.Object.Font.Size = 12
Target.Comment.Shape.OLEFormat.Object.Font.FontSty le = "Bold"
SendKeys "+{F2}"
End If
End If
End If
Application.Run("Extrait")
End Sub

A+
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

je joins un fichier "test" qui montre bien ce qui se passe !
pour le test, opter pour autre demande pao", une fenêtre commentaire apparait
y inscrire ce que vous voulez, et là.rien. Sauf si l'on reprend le choix "autre demande pao", là le commentaire va se placer en bout de ligne.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

Re

Il y a deja un probleme du fait qu'il existe dans ThisWorkbook une macro
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ensuite je suppose que tu souhaites voir reporter en target(0,32) ce que l'on ecrit dans le commentaire suite au Sendkeys ?
 
Vote positif 0 Vote négatif
Re : une aide pour "fusionner ces codes

tu supposes bien - mais en fait je ne sais pas à quoi correspond le sendkey (je pensais que c'était un raccourci clavier pour la macro 🙁)
mais c'est cela je voudrais pouvoir mette le commentaire en col 32 quans un choix précis est fait (par ex là autres demandes pao)

et cela gêne t il quelquechose ce Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) en "doublon" ?
 
Vote positif 0 Vote négatif
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

anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
268
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Insérer un commentaire après clic droit en X (colonne 24) ?
Réponses
2
Affichages
223
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Insérer un commentaire prêt à saisir de B à X sans limite... (excepté en ligne 1 ; taille de commentaire Ok déjà voir code VB en B*)
Réponses
7
Affichages
268
Nicolas JACQUIN
Nicolas JACQUIN
anthoYS
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
293
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Clic droit en F doit afficher la fenêtre de commentaire, prêt à saisir vierge. Qu'est-ce qui cloche ici ? ça copie...
Réponses
1
Affichages
155
anthoYS
anthoYS
anthoYS
  • Résolu(e)
Microsoft 365 VBA : Commentaire en B, C, D après clic droit dans n'importe quelle cellule de cette plage ?
2
Réponses
15
Affichages
844
Nicolas JACQUIN
Nicolas JACQUIN
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
509
sylvanu
sylvanu
S
  • Question Question
Microsoft 365 VBA Action suivant le résultat d'une cellule
Réponses
7
Affichages
319
TooFatBoy
TooFatBoy
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
623
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
764
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter macro pour Suppr cellules
Réponses
7
Affichages
461
un internaute
U
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
502
nabilexcel2007
N
J
  • Question Question
Microsoft 365 Worksheet_Change ou Worksheet_Calculate
Réponses
9
Affichages
511
job75
job75
anthoYS
  • Résolu(e)
Microsoft 365 Clic droit en B (Quelle que soit la cellule de cette colonne) : doit créer ou ouvrir une nouvelle note*
2
Réponses
19
Affichages
734
anthoYS
anthoYS
S
  • Résolu(e)
Microsoft 365 Déclenchement macro en série suite à cellule fusionnées
Réponses
3
Affichages
539
spike29
S
F
  • Résolu(e)
Microsoft 365 Evènement worksheet_change
Réponses
2
Affichages
306
Francky79
F
P
  • Résolu(e)
XL 2021 Comment détecter la modification MANUELLE d'une cellule dans une feuille ?
Réponses
3
Affichages
359
PRy
P
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
825
thunder23
thunder23
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
601
jalaba
J
S
  • Résolu(e)
Microsoft 365 Cliquer pour ouvrir des photos
Réponses
7
Affichages
964
Simon 1234
S
Retour