ajouter un commentaire sur une cellule précise mais variable d'un fichier Excel à partir d'Access

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

j'avais mis de côté un semblant du code proposé. pas que je ne cherche pas de mon côté. je posais la question si on doit prévoir le cas ou il y à pas encore de commentaire inscrit.

Car à l'essai, je suis enfermé dans la boucle, apparemment à l'ouverture du fichier Excel? comme tout se bloque, plus moyen de faire quoi que cela soit sur le fichier Access et le fichier Excel après avoir effectué une fin de tâche n'est accessible qu'en lecture seule car déjà utilisé. je me demandais si cela ne serait pas le cas de figure pas encor de commentaire, mais apparemment non.

J'ai vérifié le chemin et il à l'air correct, le pourquoi de ma demande si le code comporte une erreur flagrante qui m'enfermerai dans la boucle.

Je dois avouer ne pas savoir gérer la résolution de code erreur via un code vba m'empêchant de rester enfermé.

Ce qu'il me semble bizarre, c'est lors des test avec votre code tel quel cela fonctionnait bien.

Mais à l'ajout de mes paramètres à insérer dans le commentaire, je pense, cela ne fonctionne plus, alors que je ne pense pas avoir mal écrit celui-ci.
Par sécurité, je me permet de placer le code modifié.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 Private Sub insertcomment_Click() Dim oApp As Excel.Application Dim oWkb As Excel.Workbook Dim oWSht As Excel.Worksheet Dim i As Long Dim coment As String Dim dat As String coment = Me.coment.Value dat = Format(Me.Datecomment, "dd.mm.yyyy") Set oApp = CreateObject("excel.application") Set oWkb = oApp.Workbooks.Open("D:\test.xlsm") Set oWSht = oWkb.Worksheets("suivi") i = 2 ' ActiveSheet.UsedRange.Rows.Count : nb lignes utilisées dans une feuille Do While i <= oWSht.UsedRange.Rows.Count If oWSht.Range("A" & i).Value = Me.NIMMA Then ' on fait ici le traitement souhaité, par exemple sur la cellule à modifier (1 pour A, 2 pour B,..., 6 pour F)avec vérification si commentaire déjà existant oWSht.Cells(i, 6).comment.Visible = True If Len(Nz(oWSht.Cells(i, 6).comment.Text)) > 0 Then ' le commentaire de la case comporte déjà une valeur oWSht.Cells(i, 6).comment.Text Text:=oWSht.Cells(i, 6).comment.Text & vbLf & dat & coment Else oWSht.Cells(i, 6).comment.Text Text:=oWSht.Cells(i, 6).dat & coment End If Exit Do ' on sort de la boucle Else i = i + 1 End If Loop Set oWSht = Nothing oWkb.Close Set oWkb = Nothing Set oApp = Nothing End Sub

09/02/2021, 14h52
tee_grandbois

bonjour,

Citation:

je suis enfermé dans la boucle, apparemment à l'ouverture du fichier Excel? comme tout se bloque, plus moyen de faire quoi que cela soit sur le fichier Access et le fichier Excel après avoir effectué une fin de tâche

il faut sans doute mettre l'instruction i = i + 1 hors de la condition If oWSht... End If car sans cela impossible d'incrémenter i et donc de sortir de la boucle.
10/02/2021, 10h43
trouvaille

Bonjour,

i+1 se trouve après le else pour le cas où la condition du if n'est pas remplie suivie du end if.

Ce n'est pas logique? cela me semble correct pourtant

Le code ci-dessous fonctionne super.
Mais si je le remanie à mes besoins comme le code ci-dessus, cela ne fonctionne plus?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub Commande6_Click()
 
Dim oApp As Excel.Application
    Dim oWkb As Excel.Workbook, oWSht As Excel.Worksheet
    Dim i As Long
 
    Set oApp = CreateObject("excel.application")
    Set oWkb = oApp.Workbooks.Open("C:\Users\verst\OneDrive - Office 365 GPI\Bureau\NIMMA.xlsx")
    Set oWSht = oWkb.Worksheets("suivi")
    i = 2
 ' ActiveSheet.UsedRange.Rows.Count : nb lignes utilisées dans une feuille
   Do While i <= oWSht.UsedRange.Rows.Count
If oWSht.Range("A" & i).Value = Me.nimma Then
' on fait ici le traitement souhaité, par exemple, si la cellule à modifier est en colonne F
oWSht.Cells(i, 6).Comment.Visible = True
    oWSht.Cells(i, 6).Comment.Text Text:="commentaire n° 1" & Chr(10) & "Il fait beau aujourd'hui"
    oWSht.Cells(i, 6) = "essai n° 1"
 
Exit Do    ' on sort de la boucle
Else
i = i + 1
End If
 
Loop
 
    Set oWSht = Nothing
     oWkb.Close
    Set oWkb = Nothing
    Set oApp = Nothing
End Sub

10/02/2021, 13h52
tee_grandbois

bonjour,

Citation:

Envoyé par trouvaille

Bonjour,

i+1 se trouve après le else pour le cas où la condition du if n'est pas remplie suivie du end if.

Ce n'est pas logique? cela me semble correct pourtant

oui, c'est correct ... désolé pour la mauvaise piste

pour débogger plus facilement, place la valeur que tu veux mettre dans le commentaire dans une variable s1. Ceci devrait marcher
J'ai supprimé la variable coment (énervant avec un seul m ...) : non seulement inutile mais dangereux : coment = me.coment (?)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub insertcomment_Click()
Dim oApp As Excel.Application
    Dim oWkb As Excel.Workbook
    Dim oWSht As Excel.Worksheet
    Dim i As Long, dat As String, s1 as string
 
    dat = Format(Me.Datecomment, "dd.mm.yyyy")
 
    Set oApp = CreateObject("excel.application")
    Set oWkb = oApp.Workbooks.Open("D:\test.xlsm")
    Set oWSht = oWkb.Worksheets("suivi")
    i = 2
 ' ActiveSheet.UsedRange.Rows.Count : nb lignes utilisées dans une feuille
Do While i <= oWSht.UsedRange.Rows.Count
 
If oWSht.Range("A" & i).Value = Me.NIMMA Then     ' pour info:  .Range("A" & i) = .cells(i , 1)
 
' on fait ici le traitement souhaité, par exemple sur la cellule à modifier (colonne 6 pour F) et on teste si commentaire déjà existant
oWSht.Cells(i, 6).comment.Visible = True
If Len(Nz(oWSht.Cells(i, 6).comment.Text)) > 0 Then
' le commentaire de la case comporte déjà une valeur
s1= oWSht.Cells(i, 6).comment.Text & vbLf & dat  & " " & nz(Me.coment)
Else
s1=  dat & " " &  nz(Me.coment)
End If
 debug.print s1
oWSht.Cells(i, 6).comment.Text Text:=s1
Exit Do    ' on sort de la boucle
Else
i = i + 1
End If
 
Loop
 
    Set oWSht = Nothing
     oWkb.Close
    Set oWkb = Nothing
    Set oApp = Nothing
End Sub

11/02/2021, 10h40
trouvaille

Bonjour et merci de votre suivi.

Bizarrement tout fonctionne à nouveau.

Ayant modifié quelque peu le code VBA, je vais poursuivre mes tests et posterai le code VBA final si cela peut aider d'autres personnes.

Un grand merci à cette communauté qui comprend les débutants désireux de créer

Voilà, les test ont étés effectués et j'ai modifié un peu le code. je ne sais pas si c'est exécuté de la manière la plus adéquate, mais cela fonctionne.
je place les code ci-dessous cela pourra servir à d'autres.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Private Sub insertcomment_Click()
Dim xls As Excel.Application
Dim chem As String
Dim oWSht As Excel.Worksheet
Dim xlwb As Excel.Workbook
Dim i As Long
Dim commentaire As Comment
Dim dat As String
 
    dat = Format(Now(), "dd.mm.yyyy") 'initie la variable en date du jour et impose son format
    chem = Me.cheminement
 
Set xls = CreateObject("Excel.Application") 'instancie la variable xls en une application Excel
    With xls
        .Visible = False 'cache l'application Excel
        Set xlwb = .Workbooks.Open("C:\Users\eric\Desktop\NIMMA " & chem & ".xlsx") 'instancie la variable oWkb comme le chemin ou se trouve le fichier Excel
    End With
 
Set oWSht = xls.Worksheets("suivi") 'instancie la variable oWSht pour la feuille du fichier oWkb à traiter
    i = 2 'définit ou commence la lecture de la valeur de i
 
 
   Do While i <= oWSht.UsedRange.Rows.Count + 1 'Boucle des lignes du fichier jusque la condition if (valeur = Me.nimma) soit vraie  (+1 car ne prenait pas la dernière ligne???)
 
If oWSht.Range("A" & i).Value = Me.NIMMA Then 'condition que la valeur du i corresponde à l'immatriclation désirée alors
 
 
Set commentaire = oWSht.Cells(i, 6).Comment 'définit la cellule ou le commentaire devra être appliqué en rapport à la ligne trouvée (1 pour A, 2 pour B...6 pour F...)
 
    If Not commentaire Is Nothing Then 'condition que le commentaire de la cellule definie par le set n'est pas rien (commentaire déjà existant) alors
 
    With oWSht.Cells(i, 6)
    .Comment.Visible = True 'Rend visible sa case commentaire
    .Comment.Text Text:=oWSht.Cells(i, 6).Comment.Text & vbLf & dat & " " & Me.memo  'ajoute un commentaire avec la date à un commentaire existant
    .Comment.Shape.TextFrame.AutoSize = True 'Adapte le cadre de la case commentaire suivant son contenu
    End With
 
    oWSht.Cells(i, 6) = "avec commentaire" 'inscrit la valeur entre guillements dans la case correspondante
 
    Else 'si la condition d'existance de commentaire est fausse
 
        With oWSht.Cells(i, 6) 'avec la cellule trouvée correspondant à l'immatriculation exécute les actions jusqu'au End with
        .AddComment 'ajoute un nouveau commentaire
        .Comment.Visible = True  'Rend visible sa case commentaire
        .Comment.Text Text:=dat & " " & Me.memo  'inscrit la date et le nouveau commentaire
        .Comment.Shape.TextFrame.AutoSize = True 'Adapte le cadre de la case commentaire suivant son contenu
        End With
 
        oWSht.Cells(i, 6) = "sans commentaire"  'inscrit la valeur entre guillements dans la case correspondante
 
    End If 'Fin de la condition d'existance de commentaire
 
oWSht.Cells(i, 6).Comment.Visible = False 'remet les commentaires en caché
 
    Exit Do    ' on sort de la boucle
Else 'si la condition que la valeur du i corresponde à l'immatriclation n'est pas vrai, passe à la ligne suivante
i = i + 1
End If 'fin de la condition de correspondance à l'immatriculation
 
    Loop 'fin de la boucle Do While
 
   xlwb.Close (True) 'sauvegarde le fichier Excel à sa fermeture
 
 
    Set xlwb = Nothing
    Set oWSht = Nothing
    Set commentaire = Nothing
    Set xls = Nothing
 
Me.NIMMA = ""
Me.memo = ""
 
DoCmd.Requery
 
End Sub

Ma prochaine étape sera d'extraire tout les commentaires sur une feuille séparée et les imprimer . J'ai déjà trouvé plein de voies possibles sur le forum. Super.
Reste à plancher sur une méthode permettant de recopier une valeur de cellule en regard du commentaire car l'adresse de la cellule ne parle pas assez
voici ci-dessous le début du code mais sans malheureusement la recopie d'une valeur de cellule.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub CopieContenuCommentaires_Word()
    Dim Cmt As Comment
    Dim WordApp As Object
 
    'Ouvre une session Word
    Set WordApp = CreateObject("Word.Application")
 
    With WordApp
        .Visible = True
        'Ajoute un nouveau document dans Word
        .Documents.Add
 
        'Boucle sur les commentaires de la Feuil1
        For Each Cmt In Worksheets("Feuil1").Comments
            .Selection.TypeText "Cellule: " & Cmt.Parent.Address & vbCrLf & Cmt.Text
            .Selection.TypeParagraph
            .Selection.InsertBreak Type:=6  '(wdLineBreak) insert un saut de ligne
        Next
    End With
 
    Set WordApp = Nothing
End Sub

Voir 40 message(s) de cette discussion en une page