A voir également:
- Correction Macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro word - Guide
- Correction orthographe - Guide
- Telecharger clavier français avec correction - Télécharger - Divers Utilitaires
- Jitbit macro recorder - Télécharger - Confidentialité
2 réponses
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 779
29 janv. 2011 à 18:31
29 janv. 2011 à 18:31
Pas facile à comprendre !
Le code est très incomplet ! (entre autres, il manque un End With)
Remplace Feuil2 par Workbook("Gestion").Feuil6
(Le fichier Gestion doit être ouvert)
PS : Avec Excel 2007 il faut éviter .Range("B65536").End(xlUp)
Le code est très incomplet ! (entre autres, il manque un End With)
Remplace Feuil2 par Workbook("Gestion").Feuil6
(Le fichier Gestion doit être ouvert)
PS : Avec Excel 2007 il faut éviter .Range("B65536").End(xlUp)
Voici la macro au complet mais elle ne fonctionne toujours pas j'ai mis woekbook ("Gestion").Feuil6 mais ca me met erreur? :-(
Option Explicit
Sub Commentaires()
Dim Lg01 As Long
Dim Lg02 As Long
Dim Lg As Long
Dim Cl01 As Long
Dim Cel As Range
Dim Mot As String
Dim Nom As String
Dim Num As Integer
Dim I As Long
Mot = "HORJOURSRIX"
Feuil1.Cells.ClearComments
With Workbook("Gestion").Feuil6
For Lg02 = 10 To .Range("B65536").End(xlUp).Row
If .Cells(Lg02, 2) <> "" Then
Num = .Cells(Lg02, 2)
Lg01 = 0
With Feuil1
Set Cel = .Range("B10:B" & .Range("B65536").End(xlUp).Row).Find(what:=Num, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Lg01 = Cel.Row
End If
End With
If Lg01 <> 0 Then
Lg = Lg02
While .Cells(Lg, 15) <> ""
Cl01 = 1 + (.Cells(Lg, 15) * 4) + Int(InStr(1, Mot, .Cells(Lg, 13)) / 3)
Nom = .Cells(Lg, 16) & "/" & .Cells(Lg, 17) & "/" & .Cells(Lg, 18)
While Right(Nom, 1) = "/"
Nom = Left(Nom, Len(Nom) - 1)
Wend
With Feuil1.Cells(Lg01, Cl01)
If .Comment Is Nothing Then
.AddComment
.Comment.Text Text:="Info:" & vbLf
End If
.Comment.Text Text:=.Comment.Text & Nom & vbLf
.Comment.Shape.TextFrame.AutoSize = True
End With
Lg = Lg + 1
Wend
End If
End If
Next Lg02
End With
End Sub
Option Explicit
Sub Commentaires()
Dim Lg01 As Long
Dim Lg02 As Long
Dim Lg As Long
Dim Cl01 As Long
Dim Cel As Range
Dim Mot As String
Dim Nom As String
Dim Num As Integer
Dim I As Long
Mot = "HORJOURSRIX"
Feuil1.Cells.ClearComments
With Workbook("Gestion").Feuil6
For Lg02 = 10 To .Range("B65536").End(xlUp).Row
If .Cells(Lg02, 2) <> "" Then
Num = .Cells(Lg02, 2)
Lg01 = 0
With Feuil1
Set Cel = .Range("B10:B" & .Range("B65536").End(xlUp).Row).Find(what:=Num, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Lg01 = Cel.Row
End If
End With
If Lg01 <> 0 Then
Lg = Lg02
While .Cells(Lg, 15) <> ""
Cl01 = 1 + (.Cells(Lg, 15) * 4) + Int(InStr(1, Mot, .Cells(Lg, 13)) / 3)
Nom = .Cells(Lg, 16) & "/" & .Cells(Lg, 17) & "/" & .Cells(Lg, 18)
While Right(Nom, 1) = "/"
Nom = Left(Nom, Len(Nom) - 1)
Wend
With Feuil1.Cells(Lg01, Cl01)
If .Comment Is Nothing Then
.AddComment
.Comment.Text Text:="Info:" & vbLf
End If
.Comment.Text Text:=.Comment.Text & Nom & vbLf
.Comment.Shape.TextFrame.AutoSize = True
End With
Lg = Lg + 1
Wend
End If
End If
Next Lg02
End With
End Sub