Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

K

KenJ

XLDnaute Nouveau
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
 
Solution
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...
Trier par date Trier par votes

Gégé-45550

XLDnaute Accro
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,
 
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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
 
Vote positif 1 Vote négatif
Solution
K

KenJ

XLDnaute Nouveau

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.
 
Vote positif 0 Vote négatif
K

KenJ

XLDnaute Nouveau
Bonjour @fanch55,
Je pense que c'est pour copier ailleurs qu'Excel ?
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
K

KenJ

XLDnaute Nouveau
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)
Cliquez pour agrandir...

Cordialement
 
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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​


NameRequired/OptionalData typeDescription
OrientationRequiredMsoTextOrientationThe orientation of the textbox.
LeftRequiredSingleThe position (in points) of the upper-left corner of the text box relative to the upper-left corner of the document.
TopRequiredSingleThe position (in points) of the upper-left corner of the text box relative to the top of the document.
WidthRequiredSingleThe width of the text box, in points.
HeightRequiredSingleThe height of the text box, in points.

Return value​


Shape
 
Vote positif 0 Vote négatif
K

KenJ

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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
 

Pièces jointes

  • CopyVal.xlsm
    22.1 KB · Affichages: 8
Vote positif 1 Vote négatif

job75

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc
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
 
Vote positif 1 Vote négatif

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • DataObject(1).xlsm
    16.7 KB · Affichages: 5
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

C
  • Question
Microsoft 365 Insérer le contenu d'une cellule dans le texte d'une autre cellule
Réponses
2
Affichages
403
chris427
C
  • Question
Microsoft 365 Copier un fichier dans l'explorer vers le presse-papier
Réponses
0
Affichages
234
gsx-air
F
  • Question
XL 2021 VBA bouton pour copier le contenu d'une cellule
Réponses
3
Affichages
174
fuioplde
F
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
790
firecarl
F
  • Question
XL 2010 Copier cellule avec mise en forme d’une feuille sur l’autre
Réponses
12
Affichages
488
jeanmi
C
  • Résolu(e)
XL 2021 Mise en forme conditionnelle si *mot* dans cellule
Réponses
10
Affichages
286
TooFatBoy
M
  • Question
XL 2016 macro copier coller de plusieurs feuilles excel
Réponses
2
Affichages
419
klin89
C
  • Question
XL 2013 faire une formule sous Excel 2013 pour copier les mises en forme d'une autre cellule
Réponses
4
Affichages
514
cd92600
C
T
  • Question
XL 2016 macro pour vider le contenu d'un tableau synthese ( avant d’actualiser par les nouvelles données )
Réponses
7
Affichages
292
TooFatBoy
P
  • Question
Microsoft 365 Supprimer le contenu de cellules varaibles.
Réponses
4
Affichages
213
AtTheOne
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…