XL 2016 Créer une macro pour uniquement copier le contenu d'une cellule

KenJ · 28 Avril 2023

Bonjour,

1-Actuellement avec ma souris, pour copier le contenu d'une cellule, je clique sur la cellule concernée puis depuis la barre de formule, je copie (ctrl+c) le contenu de la cellule sélectionnée et je le colle (ctrl+v) vers une autre application.

2-Je fais ceci car si je copie directement la cellule par un ctrl+c et que je vais la coller (ctrl-v) dans l'autre application, le contenu garde la mise en forme et plus génant pour moi, les bordures de la cellule.

Alors, grâce à une macro et un bouton affecté, je voudrais copier une cellule qui contient du texte (sans mise en forme ni bordure), vers le presse-papier. Le contenu copié devrait être collé par un ctrl-v, vers une autre application.

Je sais faire la macro (code ci-dessous) pour copier la cellule avec le bouton cependant lorsqu'on colle (ctrl-v) le contenu vers sa destination finale (autre application), ce contenu garde la mise en forme et les bordures de la cellule. Même résultat que le point 2.

VB:

Private Sub CommandButton1_Click()
    Range("E3:M3").Copy
End Sub

Je cherche donc une solution pour que la macro puisse copier uniquement le contenu de la cellule, sans conserver aucune mise en forme, ni bordure afin que le contenu de la cellule puisse être collé par un ctrl-v vers une autre application. Autrement dit, atteindre le résultat obtenu manuellement au point 1.

Toutes les aides sont les bienvenues.
Cordialement,
KenJ

Gégé-45550 · 28 Avril 2023

KenJ à dit:
Bonjour,

1-Actuellement avec ma souris, pour copier le contenu d'une cellule, je clique sur la cellule concernée puis depuis la barre de formule, je copie (ctrl+c) le contenu de la cellule sélectionnée et je le colle (ctrl+v) vers une autre application.

2-Je fais ceci car si je copie directement la cellule par un ctrl+c et que je vais la coller (ctrl-v) dans l'autre application, le contenu garde la mise en forme et plus génant pour moi, les bordures de la cellule.

Alors, grâce à une macro et un bouton affecté, je voudrais copier une cellule qui contient du texte (sans mise en forme ni bordure), vers le presse-papier. Le contenu copié devrait être collé par un ctrl-v, vers une autre application.

Je sais faire la macro (code ci-dessous) pour copier la cellule avec le bouton cependant lorsqu'on colle (ctrl-v) le contenu vers sa destination finale (autre application), ce contenu garde la mise en forme et les bordures de la cellule. Même résultat que le point 2.

VB:

Private Sub CommandButton1_Click() [CODE=vb]With Range("E3:M3") .copy

Code:

With Range("E3:M3") .Copy .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With

.Copy
End Sub[/CODE]
Je cherche donc une solution pour que la macro puisse copier uniquement le contenu de la cellule, sans conserver aucune mise en forme, ni bordure afin que le contenu de la cellule puisse être collé par un ctrl-v vers une autre application. Autrement dit, atteindre le résultat obtenu manuellement au point 1.

Toutes les aides sont les bienvenues.
Cordialement,
KenJ

Bonjour,
À tester :
Soit "Destination" , le chemin d'accès complet à l'endroit où les données doivent être copiées (par exemple : Destination="C:\MesApplis\MonFichier.Worksheets("MaFeuille").Range("A1")"

Wiki:

With Range ("E3:M3")
    .Copy
    Destination .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

Cordialement,

fanch55 · 28 Avril 2023

Bonjour,
Je pense que c'est pour copier ailleurs qu'Excel ?
Ce code devrait fonctionner :

VB:

Sub Test()
    [E4:F5].Select:     Copy_Text
    [H4].Select:        ActiveSheet.Paste
   
    [F4:F5].Select:     Copy_Text
    [F10].Select:       ActiveSheet.Paste
   
    [F4].Select:        Copy_Text
    [B4].Select:        ActiveSheet.Paste
End Sub
Sub Copy_Text()
  ' Ajout d'une zone de texte bidon
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 30, 20)
       ' on y met le texte de la/les cellule(s)
        If Selection.Cells.Count = 1 Then
            .TextFrame2.TextRange.Characters.Text = Selection.Text
        Else
            Dim Tbl As String, Txt As String
            Tbl = "Début_Ligne"
            For Each R In Selection.Rows
                Txt = "Début_Colonne"
                For Each C In R.Columns
                    If Txt = "Début_Colonne" Then Txt = C Else Txt = Txt & vbTab & C
                Next
                If Tbl = "Début_Ligne" Then Tbl = Txt Else Tbl = Tbl & vbLf & Txt
            Next
            .TextFrame2.TextRange.Characters.Text = Tbl
        End If
        .TextFrame2.TextRange.Copy ' Envoi du contenu vers le presse papier
        .Delete ' suppression de la zone de texte
    End With
    Application.CutCopyMode = False
End Sub

Sélectionnez la/les cellules à copier et exécutez Copy_Text

La sub Test est un exemple de ce que peut faire Copy_Text

KenJ · 28 Avril 2023

Gégé-45550 à dit:
Bonjour,
À tester :
Soit "Destination" , le chemin d'accès complet à l'endroit où les données doivent être copiées (par exemple : Destination="C:\MesApplis\MonFichier.Worksheets("MaFeuille").Range("A1")"

Wiki:

With Range ("E3:M3") .Copy Destination .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With

Cordialement,

Bonjour,
Merci d'avoir répondu!
L'action du "collé" doit se faire par un ctrl+v en dehors de excel et à des emplacements précis.
Le PasteSpecial n'est pas la solution dans mon cas.
Cordialement.

KenJ · 28 Avril 2023

Bonjour @fanch55,

Je pense que c'est pour copier ailleurs qu'Excel ?

Oui, tout à fait. C'est pour copier vers une page web en ligne.

Votre proposition retient mon intérêt. Je me penche dessus.

Merci d'avoir pris le temps de me répondre et en passant, je fais un petit clin d'oeil à votre avatar qui m'a donné le sourire !

Cordialement

KenJ · 28 Avril 2023

Re bonjour @fanch55 ,
Le code que vous avez proposé répond parfaitement au contexte et au résultat attendu.

Je vous remercie pour la solution que vous avez quand même rapidement suggérée et de plus, le code est commenté !

Afin d'en savoir un peu plus, pourriez vous m'expliquer ce bout de code et l'impact des valeurs 0,0,30,20 :

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 30, 20)

Cordialement

fanch55 · 28 Avril 2023

KenJ à dit:
Afin d'en savoir un peu plus, pourriez vous m'expliquer ce bout de code et l'impact des valeurs 0,0,30,20 :

Cliquez pour agrandir...

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 30, 20)

Cordialement

On ajoute une "Zone de texte" à la feuille dont le texte est Horizontal.
Les chiffres sont les positions et dimensions de celle-ci,
aucun impact dans le code car cette zone est éphémère.

Shapes.AddTextbox method (Excel)

Creates a text box. Returns a Shape object that represents the new text box.

Syntax

expression.AddTextbox (Orientation, Left, Top, Width, Height)

expression A variable that represents a Shapes object.

Parameters

Name	Required/Optional	Data type	Description
Orientation	Required	MsoTextOrientation	The orientation of the textbox.
Left	Required	Single	The position (in points) of the upper-left corner of the text box relative to the upper-left corner of the document.
Top	Required	Single	The position (in points) of the upper-left corner of the text box relative to the top of the document.
Width	Required	Single	The width of the text box, in points.
Height	Required	Single	The height of the text box, in points.

Return value

Shape

KenJ · 28 Avril 2023

Merci pour ce retour !
Pour revenir à votre code du post 3 : peut-on ajouter un effet visuel quelconque sur la cellule et qui sera visible après l'exécution Copy_Text, histoire de savoir quelle cellule vient d'être copiée ?

fanch55 · 28 Avril 2023

Testez le classeur joint
Le code est dans Module1

VB:

Public SPattern As Object
Sub Copy_Text()
    Restore_Patterns
  ' Ajout d'une zone de texte bidon
    With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 30, 20)
       ' on y met le texte de la/les cellule(s)
        Dim Tbl As String, Txt As String
        Tbl = "Début_Ligne"
        For Each R In Selection.Rows
            Txt = "Début_Colonne"
            For Each c In R.Columns
                If Txt = "Début_Colonne" Then Txt = c Else Txt = Txt & vbTab & c
              ' On sauvegarde le Pattern de la cellule
                SPattern.Add c.Address, Array(ActiveSheet.Name, c.Interior.Pattern, c.Interior.Color)
              ' On change le pattern de la cellule
                c.Interior.Color = 13434879
            Next
            If Tbl = "Début_Ligne" Then Tbl = Txt Else Tbl = Tbl & vbLf & Txt
        Next
        .TextFrame2.TextRange.Characters.Text = Tbl
        .TextFrame2.TextRange.Copy ' Envoi du contenu vers le presse papier
        .Delete ' suppression de la zone de texte
    End With
    Application.CutCopyMode = False
End Sub
Sub Restore_Patterns()
   ' Un élément de dictionnaire porte l'adresse de la cellule
   ' et a comme valeur un tableau qui indique le nom de feuille , son pattern et sa couleur
    If Not SPattern Is Nothing Then
        For Each Elem In SPattern
            With Sheets(SPattern(Elem)(0)).Range(Elem).Interior
                .Pattern = SPattern(Elem)(1)
                If .Pattern <> xlNone Then .Color = SPattern(Elem)(2)
            End With
        Next
    End If
    Set SPattern = CreateObject("Scripting.Dictionary")
End Sub
Sub Reset_SPattern()
    Set SPattern = Nothing
End Sub

et dans Thisworkbook .

VB:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Restore_Patterns
End Sub

job75 · 28 Avril 2023

Bonsoir Kenj, Gégé-45550, fanch55,

On peut aussi utiliser le DataObject pour mettre le texte dans le presse-papiers :

VB:

Sub PressePapiers()
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
    .SetText ActiveCell
    .PutInClipboard
    ActiveCell.Interior.Color = vbCyan
End With
End Sub

Bonne nuit.

fanch55 · 29 Avril 2023

Re à tous,
La formule de @job75 est idéale pour copier une et une seule cellule
et pour colorer les cellules copiées sans retour à la normale .

Mais on peut s'en servir avec mon code pour arriver à ce que vous demandez .

VB:

Option Explicit
Public SPattern As Object
Sub Copy_Text()
Dim Rw As Range, Cl As Range
    Restore_Patterns
  ' DataObject en late binding
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        Dim Tbl As String ' c'est ce qu'on va mettre dans le Presse-Papier
        Dim Txt As String ' une des lignes de Tbl
        Tbl = "Début_Table"
        For Each Rw In Selection.Rows
            Txt = "Début_Colonne"
            For Each Cl In Rw.Cells
              ' cumul des cellules sélectionnées
                If Txt = "Début_Colonne" Then Txt = Cl Else Txt = Txt & vbTab & Cl
              ' On sauvegarde le Pattern de la cellule
                SPattern.Add Cl.Address, Array(ActiveSheet.Name, Cl.Interior.Pattern, Cl.Interior.Color)
              ' On change le pattern de la cellule
                Cl.Interior.Color = 13434879
                Cl.Interior.Pattern = xlGray25
            Next
          ' cumul des lignes construites
            If Tbl = "Début_Table" Then Tbl = Txt Else Tbl = Tbl & vbLf & Txt
        Next
        .SetText Tbl
        .PutInClipboard
    End With
End Sub
Sub Restore_Patterns()
   ' On va restaurer les patterns initiaux des cellules
   ' qui ont pu être copiées par Copy_Text
Dim Elem
   ' Un élément de dictionnaire porte l'adresse de la cellule
   ' et a comme valeur un tableau qui indique le nom de feuille , son pattern et sa couleur
    If Not SPattern Is Nothing Then
        For Each Elem In SPattern
            With Sheets(SPattern(Elem)(0)).Range(Elem).Interior
                .Pattern = SPattern(Elem)(1)
                If .Pattern <> xlNone Then .Color = SPattern(Elem)(2)
            End With
        Next
    End If
   ' Raz du Spattern
    Set SPattern = CreateObject("Scripting.Dictionary")
End Sub

VB:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Restore_Patterns
End Sub

job75 · 29 Avril 2023

Bonjour Kenj, Gégé-45550, fanch55,

Si l'on veut copier une plage (de cellules jointives) il faut en effet concaténer avec vbTab et vbLf :

VB:

Sub PressePapiers()
Dim P As Range, ncol%, i&, x$, j%
Set P = Selection.Areas(1)
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
    If i > 1 Then x = x & vbLf
    For j = 1 To ncol
        x = x & IIf(j = 1, "", vbTab) & P(i, j)
Next j, i
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' DataObject en late binding
    .SetText x
    .PutInClipboard
End With
P.Interior.Color = vbCyan
End Sub

A+

KenJ · 2 Mai 2023

Bonjour @fanch55, @job75

Merci à tous d'avoir partagé vos connaissances. C'est appréciable !
@fanch55, le code que vous avez proposé en post 9 convient parfaitement.
Celui en post 11, avec la suggestion de @job75 convient aussi.

Je peux dire que le sujet est clos.
Belle journée,
Cordialement.

Effectuez une recherche sur Excel Downloads...

XL 2016 Créer une macro pour uniquement copier le contenu d'une cellule

KenJ

XLDnaute Nouveau

fanch55

Gégé-45550

XLDnaute Accro

fanch55

XLDnaute Barbatruc

KenJ

XLDnaute Nouveau

KenJ

XLDnaute Nouveau

KenJ

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Shapes.AddTextbox method (Excel)

Syntax

Parameters

Return value

KenJ

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

KenJ

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums

XL 2016 Créer une macro pour uniquement copier le contenu d'une cellule

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

Shapes.AddTextbox method (Excel)​

Syntax​

Parameters​

Return value​

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Discussions similaires

Partager cette page

Statistiques des forums

Shapes.AddTextbox method (Excel)

Syntax

Parameters

Return value