Copier le commentaire d'un cellule dans un tableau

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion lsohier
  • Date de début Date de début

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
L

lsohier

Guest
Bonjour à tous,

j'ouvre un fil car j'ai un petit problème.

j'ai une macro qui récupère la valeur d'une cellule Excel et je souhaiterai pouvoir récupérer le commentaire de cette cellule dans mon tableau.


D'avance merci de vos retour.
Code: 
  If IsNumeric(Cells(indligne, indcolonne)) Then
                charges(x, 1) = charges(x, 1) + Cells(indligne, indcolonne)
                charges(x, y) = charges(x, y) + Cells(indligne, indcolonne)

Merci 😱
 
Trier par date Trier par votes
Re : Copier le commentaire d'un cellule dans un tableau

re 🙂

Et on le voit où le With dans le code que tu as fourni dans ton premier post ? 😱

Ce message n'est certainement pas pas provoqué par le code " .comment.text"
Il faut adapter à ton fichier réel, ou alors fournir un extrait de ton fichier (avec le code) pour que l'on puisse tester exactement dans les mêmes conditions que toi.

Bien à toi,

mth
 
Vote positif 0 Vote négatif
Re : Copier le commentaire d'un cellule dans un tableau

Merci de te pencher sur mon pb.

voici le code de la fonction. Je récupère des charges dans un TABLEAU que j'envoie vers une nouvelle feuille excel. C'est au niveau du code en gras que je voudrais récupérer le commentaire associé à la cellule que je copie dans le tableau 'Charge' pour l'insérer ensuite dans mon nouveau fichier excel (en bas)

Merci 😉


Code: 
Sub MEFExcel(ByRef TRG, ByRef NBSem, ByRef semaine)

Dim Feuildonnees As Worksheet
Dim indligne As Integer
Dim indcolonne As Integer
Dim projets(60, 3) As String
Dim charges(60, 53) As Single
Dim prestaffe(60, 53) As Integer
Dim semaines(52) As String
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim cmt As String


Set Feuildonnees = sh_donnees

Feuildonnees.Select

With Feuildonnees
    If .FilterMode = True Then .ShowAllData
End With

For x = 1 To 60
    projets(x, 1) = ""
    projets(x, 2) = ""
    projets(x, 3) = ""
    For y = 1 To 53
        charges(x, y) = 0
        prestaffe(x, y) = 0
    Next
Next

' trouver la ressource
indligne = 7
    
While Cells(indligne, 2) <> TRG
    indligne = indligne + 1
Wend

' trouver la colonne de début
indcolonne = 16

While Cells(4, indcolonne).Interior.ColorIndex <> 6
    indcolonne = indcolonne + 1
Wend

semaine = Cells(4, indcolonne)

indcolonnedeb = indcolonne

x = 1
' tant qu'on est sur la même ressource
While Cells(indligne, 2) = TRG
    ' on verifie que la ligne soit différente de "marge pour risque" et ""
    If Cells(indligne, 7) <> "Marge pour risque" And Cells(indligne, 6) <> "" And Cells(indligne, 5) <> "fini" Then
        ' on remplit le tableau projets et on traite le nombre de colonnes souhaité
        projets(x, 1) = Cells(indligne, 7)
        If Left(Cells(indligne, 6), 2) = "P0" Or Left(Cells(indligne, 6), 2) = "R2" Or Left(Cells(indligne, 6), 2) = "A2" Then
            projets(x, 1) = Left(Cells(indligne, 6), 19) & " - " & projets(x, 1)
        End If
        projets(x, 2) = Cells(indligne, 9)
        If Cells(indligne, 11) <> "" Then
            projets(x, 2) = Cells(indligne, 11) & " - " & projets(x, 2)
        End If
        projets(x, 3) = Cells(indligne, 13)
        indcolonne = indcolonnedeb
        y = 2
        For i = 1 To NBSem
            ' par contre si on est en fin de planning on arrête
            If Cells(4, indcolonne) = "" Then
                Exit For
            End If
            ' on note la semaine
            semaines(i) = Cells(4, indcolonne)
            ' on remplit le tableau et charges
[B]            If IsNumeric(Cells(indligne, indcolonne)) Then
                charges(x, 1) = charges(x, 1) + Cells(indligne, indcolonne)
                charges(x, y) = charges(x, y) + Cells(indligne, indcolonne)[/B]
                
                ' pré-staffé jaune
                If Cells(indligne, indcolonne).Interior.ColorIndex = 6 Or Cells(indligne, indcolonne).Interior.ColorIndex = 36 Then
                    prestaffe(x, y) = 1
                End If
                ' conges valides bleu
                If Cells(indligne, indcolonne).Interior.ColorIndex = 8 Or Cells(indligne, indcolonne).Interior.ColorIndex = 33 Or _
                Cells(indligne, indcolonne).Interior.ColorIndex = 37 Or Cells(indligne, indcolonne).Interior.ColorIndex = 42 Then
                    prestaffe(x, y) = 2
                End If
                ' pré-staffé sans OM orange
                If Cells(indligne, indcolonne).Interior.ColorIndex = 46 Or Cells(indligne, indcolonne).Interior.ColorIndex = 45 Or _
                Cells(indligne, indcolonne).Interior.ColorIndex = 44 Or Cells(indligne, indcolonne).Interior.ColorIndex = 40 Then
                    prestaffe(x, y) = 3
                End If
            Else
                Cells(indligne, indcolonne).ClearContents
            End If
            indcolonne = indcolonne + 1
            If Cells(4, indcolonne) = Cells(4, indcolonne - 1) Then
                i = i - 1
            Else
                y = y + 1
            End If
        Next
        x = x + 1
    End If
    indligne = indligne + 1
Wend

'on crée un classeur
Workbooks.Add
Cells(1, 1) = " Projet"
Cells(1, 2) = "Module"
Cells(1, 3) = "CdP"
Columns("A:A").ColumnWidth = 33.57
Columns("B:B").ColumnWidth = 22.14
Columns("C:C").ColumnWidth = 14
Rows("1:1").Font.Bold = True
Columns("A:C").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
ActiveWindow.DisplayZeros = False

y = 4
For i = 1 To NBSem
    Cells(1, y) = semaines(i)
    y = y + 1
Next
' tant qu'on a pas fini de traiter ses projets
x = 1
indligne = 2
While projets(x, 1) <> ""
    ' on affiche que si la somme de la charge est <> 0 pour la période souhaitée
    If charges(x, 1) <> 0 Then
        Cells(indligne, 1) = projets(x, 1)
        Cells(indligne, 2) = projets(x, 2)
        Cells(indligne, 3) = projets(x, 3)
        y = 2
        indcolonne = 4
        For i = 1 To NBSem
            Cells(indligne, indcolonne) = charges(x, y)
             ' pré-staffé jaune
            If prestaffe(x, y) = 1 Then
                Cells(indligne, indcolonne).Interior.ColorIndex = 36
            End If
            ' congé validé bleu
            If prestaffe(x, y) = 2 Then
                Cells(indligne, indcolonne).Interior.ColorIndex = 8
            End If
            ' pré-staffé sans OM orange
            If prestaffe(x, y) = 3 Then
                Cells(indligne, indcolonne).Interior.ColorIndex = 45
            End If
            indcolonne = indcolonne + 1
            y = y + 1
        Next
        indligne = indligne + 1
    End If
    x = x + 1
Wend

LetCol = Split(Cells(1, indcolonne - 1).Address, "$")(1)
Range("A1:" & LetCol & "1").Interior.ColorIndex = 22
Range("A2:C" & indligne - 1).Interior.ColorIndex = 24
Range("A1:" & LetCol & indligne - 1).Borders.LineStyle = xlContinuous
Range("A1:" & LetCol & indligne - 1).Borders.Weight = xlMedium
If indligne - 1 > 2 Then
    Range("A2:" & LetCol & indligne - 1).Borders(xlInsideHorizontal).Weight = xlThin
End If
If indcolonne - 1 > 4 Then
    Range("D1:" & LetCol & indligne - 1).Borders(xlInsideVertical).Weight = xlThin
End If
Columns("D:" & LetCol).ColumnWidth = 5
Range("D2").Select
ActiveWindow.FreezePanes = True

' on enregistre le fichier avec comme nom le trigramme de la ressource traitée
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ArboRacine & "Plannings\Plannings Ressources\" & TRG & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
Application.DisplayAlerts = True
ActiveWindow.Close

End Sub
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : Copier le commentaire d'un cellule dans un tableau

Bonsoir,

Au risque de me pencher sur ton problème, je crains fort de passer par dessus la barrière....

Lire un code, n'est pas difficile en soi....

Lorsque ce code comprend des tableaux, à plusieurs dimensions, cela devient déjà un peu plus problématique....

Pour peu qu'on y rajoute des boucles, pour compléter ces tableaux, sans savoir exactement (et pour preuve), ce qu'on recherche, là, en général, on fait appel à la boule de cristal....

Euh, finalement, je t'envie, parce que toi, tu as de la chance, tu as ton fichier devant toi, fichier que tu as conçu, élaboré, et que tu cherches à améliorer...

Nous, on n'a pas de chance, on doit se référer à c'te p'...de boule de cristal, qui ne veut pas nous aider....

Excuse ma prose, mais sans fichier, je pense qu'il va être difficile de t'aider plus avant, le code que Mireille t'a donné fonctionne, dans son contexte, et à priori pas dans ton cas...

Bonne chance
 
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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

J
  • Résolu(e)
Microsoft 365 Première cellule vide ou égal zéros dans une plage définie
Réponses
11
Affichages
453
juju91
J
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
1 K
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
nightswan
  • Résolu(e)
Microsoft 365 Récupération d'une valeur particulière dans un tableau...
Réponses
13
Affichages
407
nightswan
nightswan
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
542
AtTheOne
AtTheOne
nat54
  • Résolu(e)
Microsoft 365 Découper un fichier en plusieurs fichiers
2
Réponses
24
Affichages
820
nat54
nat54
PMG
  • Résolu(e)
XL 2021 Récupérer l'adresse d'un résultat d'une cellule cible.
Réponses
9
Affichages
275
PMG
PMG
S
  • Question Question
XL 2013 Copier automatiquement des données dans plusieurs onglets
Réponses
4
Affichages
673
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 Reporter la valeur d'une cellule dans le pied de page.
2
Réponses
17
Affichages
288
sylvanu
sylvanu
fenec
  • Résolu(e)
Autres Copier/ Coller plage de données dans une autre cellule d'un même onglet
Réponses
6
Affichages
467
fenec
fenec
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
571
Abi23
A
C
  • Résolu(e)
XL 2019 User Form qui renvoi dans un tableau avec celulle fusionnée
2
Réponses
16
Affichages
340
Piment
P
Y
  • Résolu(e)
XL 2013 Bloquer la saisie dans une plage selon un critère
Réponses
6
Affichages
681
TooFatBoy
TooFatBoy
P
  • Résolu(e)
XL 2021 Comment détecter la modification MANUELLE d'une cellule dans une feuille ?
Réponses
3
Affichages
326
PRy
P
A
  • Résolu(e)
Microsoft 365 Insérer un résultat dans une cellule d'un tableau
Réponses
5
Affichages
355
Alain 79
A
S
  • Résolu(e)
Microsoft 365 VBA Concaténer contenu de plusieurs cellules dans une seule avec séparateurs / évolutifs
Réponses
3
Affichages
631
spike29
S
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
817
KRUG WOO
K
B
  • Résolu(e)
XL 2013 Comment inversé l'ordre d'enregistrement des lignes dans un tableau
Réponses
6
Affichages
582
bedley
B
R
  • Question Question
XL 2021 Calcul dans une requête SQL - Microsoft QUERY
Réponses
6
Affichages
448
crocrocro
C
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
888
picc
P
O
  • Question Question
Microsoft 365 mis a jour d'un onglet a un autre dans excel
Réponses
4
Affichages
269
Olivier60
O
Retour