Aide Erreur 1004 VBA Planning
Bonjour,
Depuis quelques heures, j'essaye de résoudre un problème de mon côté. Je vous l'expose :
Lorsque je remplis les informations et je choisis une date, pour le premier enregistrement, mon programme marche (un commentaire est indiqué sur le calendrier, à la date voulue (étiquette courage sur le coin)). Dès lors où je veux faire un deuxième enregistrement, mon programme comme à émettre une erreur d’exécution '1004'.
Cela dit, le programme enregistre bien les informations dans l'autre feuille. Et c'est notamment le cas, quand j'essaye de modifier les informations. Pour le premier enregistrement, cela se passe sans encombre. Mais dès que je modifie le deuxième enregistrement, il y la même erreur qui revient. Tout comme la création, la modification est bel et bien pris en compte.
Je vous mets mon programme en pièce jointe. J'y ai mis les indications pour que vous compreniez ma logique.
Merci encore pour vos futures indications ! (Et si vous avez des idées pour que je puisse améliorer / optimiser mon fichier, je suis preneur !
Bonjour,
L'erreur provient des commentaires. S'il y en a pas à une date donnée, on peut en ajouter un à cette date donnée.
Mais s'il y a déjà un commentaire à une date donnée et que le code tente d'ajouter à nouveau un commentaire à cette date donnée ... l'erreur survient.
Il faut donc, avant d'ajouter un commentaire, tester s'il y en a déjà un.
Un essai ...
Sub ajouter_com()
Dim Ligne_cal As Integer: Dim Colonne_cal As Integer
Dim ligne As Integer: Dim colonne As Integer
Dim la_date As String: Dim le_contenu As String
Dim test As Boolean
Dim Commentaire As Comment
ligne = 3: colonne = 2
With Worksheets("liste_rv")
While (.Cells(ligne, colonne).Value <> "")
la_date = .Cells(ligne, 4).Value
le_contenu = .Cells(ligne, 5).Value
test = False
For Ligne_cal = 7 To 37
For Colonne_cal = 3 To 14
With Worksheets("Calendrier")
If (.Cells(Ligne_cal, Colonne_cal).Value = la_date) Then
Set Commentaire = .Cells(Ligne_cal, Colonne_cal).Comment ' ajout ici
If Commentaire Is Nothing Then ' et test ici
.Cells(Ligne_cal, Colonne_cal).AddComment
.Cells(Ligne_cal, Colonne_cal).Comment.Visible = False
.Cells(Ligne_cal, Colonne_cal).Comment.Text Text:=le_contenu
test = True
Exit For
End If ' ajout ici pour terminer le IF
End If
End With
Next Colonne_cal
If (test = True) Then Exit For
Next Ligne_cal
ligne = ligne + 1
Wend
End With
End Subric
Bonjour,
L'erreur provient des commentaires. S'il y en a pas à une date donnée, on peut en ajouter un à cette date donnée.
Mais s'il y a déjà un commentaire à une date donnée et que le code tente d'ajouter à nouveau un commentaire à cette date donnée ... l'erreur survient.
Il faut donc, avant d'ajouter un commentaire, tester s'il y en a déjà un.
Un essai ...
Sub ajouter_com() Dim Ligne_cal As Integer: Dim Colonne_cal As Integer Dim ligne As Integer: Dim colonne As Integer Dim la_date As String: Dim le_contenu As String Dim test As Boolean Dim Commentaire As Comment ligne = 3: colonne = 2 With Worksheets("liste_rv") While (.Cells(ligne, colonne).Value <> "") la_date = .Cells(ligne, 4).Value le_contenu = .Cells(ligne, 5).Value test = False For Ligne_cal = 7 To 37 For Colonne_cal = 3 To 14 With Worksheets("Calendrier") If (.Cells(Ligne_cal, Colonne_cal).Value = la_date) Then Set Commentaire = .Cells(Ligne_cal, Colonne_cal).Comment ' ajout ici If Commentaire Is Nothing Then ' et test ici .Cells(Ligne_cal, Colonne_cal).AddComment .Cells(Ligne_cal, Colonne_cal).Comment.Visible = False .Cells(Ligne_cal, Colonne_cal).Comment.Text Text:=le_contenu test = True Exit For End If ' ajout ici pour terminer le IF End If End With Next Colonne_cal If (test = True) Then Exit For Next Ligne_cal ligne = ligne + 1 Wend End With End Subric
Bonjour,
Merci beaucoup pour l'aide ! J'avais commencé à développer le code sur cette condition de mon côté. Je vais me permettre d'utiliser quelques unes de vos indications pour pouvoir compléter ce que j'avais débuté.
Encore merci pour votre aide !
ric
Salut,
Tu boucles systématiquement sur toutes tes lignes de RV,
donc 1er passage, pas de commentaire, pas de bug pour l'ajout
2ème passage, le commentaire existe, donc bug si pas de suppression avant
Voici le code modifié
Sub ajouter_com()
Dim Ligne As Long
Dim Ligne_Cal As Long, Colonne_Cal As Long
Dim la_date As String, le_contenu As String
Dim MonCom As Comment
Dim DLig As Long
' Définir la feuille de destination
Set ShtD = ThisWorkbook.Sheets("Calendrier")
' Avec la feuille des RDV
With ThisWorkbook.Sheets("Liste_rv")
' Trouver la dernière ligne
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Ligne = 4 To DLig
If .Range("D" & Ligne).Value = "" Then GoTo SuiteLigne
' Récupérer la date et le contenu
la_date = .Cells(Ligne, 4).Value
le_contenu = .Cells(Ligne, 5).Value
' Pas besoin de boucle il suffit de calculer les coordonnées
' Calculer la position de la cellule
Ligne_Cal = 6 + Day(la_date)
' Calculer la position de la colonne
Colonne_Cal = 2 + Month(la_date)
' Vérifier si existe déjà un commentaire
Set MonCom = ShtD.Cells(Ligne_Cal, Colonne_Cal).Comment
' Si existe un commentaire
If Not MonCom Is Nothing Then
' On l'efface
ShtD.Cells(Ligne_Cal, Colonne_Cal).ClearComments
End If
' Inscrire le commentaire
ShtD.Cells(Ligne_Cal, Colonne_Cal).AddComment
ShtD.Cells(Ligne_Cal, Colonne_Cal).Comment.Visible = False
ShtD.Cells(Ligne_Cal, Colonne_Cal).Comment.Text Text:=le_contenu
SuiteLigne:
Next Ligne
End With
End SubTu trouveras ci-joint ton fichier modifié
Nota : il y a beaucoup plus simple qu'une boucle pour trouver la ligne/colonne d'une date
Edit : oups on est réveillé à cette heure