Envoyer zone text & range cells dans commentaire

Le 05/07/2015 à 15:58

Bonjour à tous,

Vous trouverez ci-joint le fichier xlsm

Dans ce fichier, je tente au travers un bouton rouge de copier le contenu de la zone texte "ZoneTexte 1" dans un commentaire B3.

Ça fonctionne.

Cependant quand je tente d'y ajouter en dessous de ce texte les cells de G5:G20 ça ne marche plus sauf pour une seule cellule et ca écrase le texte précédemment envoyé dans le commentaire.

Pourriez vous y jeter un coup d’œil SVP ?

Sub button()
Application.ScreenUpdating = False
          With Range("B3")
            .ClearComments
            .AddComment
            Dim txBox As Shape
            Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
            .Comment.Text Text:=txBox.TextFrame.Characters.Text
            .Comment.Shape.TextFrame.AutoSize = True
            .Comment.Shape.TextFrame.Characters.Font.Size = 12
            .Comment.Text Text:=Range("G5").Value & Chr(10) 'Range("G5:G20").Value & Chr(10)
            End With
End Sub

J'en profite pour poser une deuxième question en rapport au MFC SVP qui pourtant parait simple :

Quand je tente de dupliquer une mise en forme conditionnelle, ça marche pour une même colonne comme ceci :

$L$3 devient $L3

Formule : = $L3=5 s'applique à =$L$3:$L$20

Cependant quand je fais ceci pour que cela puisse s'appliquer sur deux colonnes, ça ne marche pas :

Formule : = $L3=5 s'applique à =$L$3:$L$20;$M$3:$M$20

Un grand merci d'avance

13605072015-1.xlsm (19.21 Ko)
Le 05/07/2015 à 16:40

Bonjour

Essaie ceci :

Dim txBox As Shape, msge
Sub button()

Application.ScreenUpdating = False
    Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
    msge = txBox.TextFrame.Characters.Text
    msge = msge & Chr(10) & Range("G5")
     With Range("B3")
        .ClearComments
        .AddComment
        Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
        .Comment.Text Text:=msge
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.TextFrame.Characters.Font.Size = 12
        '.Comment.Text Text:=Range("G5").Value & Chr(10) 'Range("G5:G20").Value & Chr(10)
    End With
End Sub

Pour le reste....

Bye !

Bonjour

Essaie ceci :

Dim txBox As Shape, msge
Sub button()

Application.ScreenUpdating = False
    Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
    msge = txBox.TextFrame.Characters.Text
    msge = msge & Chr(10) & Range("G5")
     With Range("B3")
        .ClearComments
        .AddComment
        Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
        .Comment.Text Text:=msge
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.TextFrame.Characters.Font.Size = 12
        '.Comment.Text Text:=Range("G5").Value & Chr(10) 'Range("G5:G20").Value & Chr(10)
    End With
End Sub

Pour le reste....

Bye !

Le 05/07/2015 à 17:13

Bonjour gmb,

...
msge = txBox.TextFrame.Characters.Text
msge = msge & Chr(10) & Range("G5")
...

car marche nickel, cependant je suis toujours dans l'impossibilité d'étendre à :G20 il continue de planter

msge = msge & Chr(10) & Range("G5:G20")

Pour le reste c'est simplement que quand je tente d'étendre une MFC sur plusieurs colonnes, je dois alors réécrire la MFC pour chaque colonne rouge si 1, vert si 3 ,,,, c'est pas grave je vais tenter de l'écrire en VB.

Le 05/07/2015 à 17:44

Bonjour,

Juste pour la 1ère question....

Sub button()
Dim txBox As Shape
Dim Msg As String
Application.ScreenUpdating = False
With Range("B3")
    .ClearComments
    .AddComment
    Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
    Msg = txBox.TextFrame.Characters.Text & Chr(10) & Join(Application.Transpose(Range("G5:G20")), Chr(10))
    .Comment.Text Text:=Msg
    .Comment.Shape.TextFrame.AutoSize = True
    .Comment.Shape.TextFrame.Characters.Font.Size = 12
End With
End Sub

Bonne journée

Le 05/07/2015 à 18:33
    Dim txBox As Shape, msge

    Sub button()
    Application.ScreenUpdating = False

    Set txBox = ActiveSheet.Shapes("ZoneTexte 1")

    msge = txBox.TextFrame.Characters.Text
    msge = msge & Chr(10) & Chr(10) & Join(Application.Transpose(Range("G5:G20")), Chr(10))

     With Range("B3")
        .ClearComments
        .AddComment
        Set txBox = ActiveSheet.Shapes("ZoneTexte 1")
        .Comment.Text Text:=msge
        '.Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.Width = 360
        .Comment.Shape.Height = 500
        .Comment.Shape.TextFrame.Characters.Font.Size = 12
    End With

 End Sub

Merci

▲ Merci à vous deux, avec vos deux codes j'ai pu en assembler un qui donne ce que je cherche à faire.

Pour la MFC voici une capture et mon problème :

Comme vous pouvez le voir dans l'image ▼, j'ai pu étendre ma MFC de L3 à L26

Cependant pour avoir la même chose pour M3 à M26 je suis obligé de réécrire la MFC :/

Merci sincèrement

capture
Le 05/07/2015 à 18:45

Re-,

Pour la 1ère, je ne vois pas pourquoi tu affectes 2 fois ta Textbox....(dans mon code, j'avais un peu synthétisé....)

Pour la MFC, essaie en supprimant le $ devant L, et recopie vers la colonne M

Le 05/07/2015 à 18:59
cousinhub a écrit :

Re-,

Pour la 1ère, je ne vois pas pourquoi tu affectes 2 fois ta Textbox....(dans mon code, j'avais un peu synthétisé....)

Pour la MFC, essaie en supprimant le $ devant L, et recopie vers la colonne M

Pour le premier code c'est une erreur de ma part. J'ai supprimé la deuxième affectation.

Pour le second : je peux étendre à l'autre colonne la MFC sans les $.

Un grand merci à vous deux

capture2
Rechercher des sujets similaires à "envoyer zone text range commentaire"