Copier le contenu d'une zone de texte ou d'un rectangle dans une cellule

Bonjour,

Je souhaite récupérer le contenu d'une zone de texte présent dans un classeur pour le mettre dans une cellule du classeur actif.

Cependant je ne sais pas quelle syntaxe utiliser! J'ai la solution pour les Checkbox, donc je me dis que la syntaxe doit être similaire. Je vous mets le code à la suite :

Sub PR()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet source)
Dim ch As CheckBox

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Caractéristique PR")
Workbooks.Open Filename:="K:\Fichier de travail\Fiche _PR GRAGNAGUE.xlsx"
Set CS = Workbooks("Fiche _PR GRAGNAGUE.xlsx") 'définit le classeur source CS
i = 2
j = Worksheets.Count
n = 4
OD.Range("C4:G15").ClearContents

While i <= j
    Set OS = CS.Sheets(i)
    OD.Range("C" & n) = OS.Name

'###### Diamètre et marnage ######
    If CS.Sheets(i).TextBox("Zone Texte 2064").Value <> "" Then
        OD.Cells(n, "D") = CS.Sheets(i).TextBox("Zone Texte 2064").Value
    End If

'###### Présence de Top plein######

'si la case 63 est cochée : on ecrit non, si la case 62 est coché on écrit oui, et si aucune des deux n'est cochées on écrit "-"
    If CS.Sheets(i).CheckBoxes("Check Box 63").Value = xlOn Then
        OD.Cells(n, "J") = "Non"
    ElseIf CS.Sheets(i).CheckBoxes("Check Box 62").Value = xlOn Then
        OD.Cells(n, "J") = "Oui"
    Else
        OD.Cells(n, "J") = "-"
    End If

'###### Présence de Télésurveillance######
    If CS.Sheets(i).CheckBoxes("Check Box 38").Value = xlOn Then
        OD.Cells(n, "K") = "Non"
    ElseIf CS.Sheets(i).CheckBoxes("Check Box 37").Value = xlOn Then
        OD.Cells(n, "K") = "Oui"
    Else
        OD.Cells(n, "K") = "-"
    End If

'on recommence la boucle pour changer de feuille
    i = i + 2
    n = n + 1

    Wend

CS.Close False
End Sub

Mon problème survient dans la partie 'Diamètre et marnage', où la syntaxe est surement très mauvaise ! L'erreur 5 est affiché.

J'aimerai récupérer le contenu de la zone de texte 2064. En testant auparavant qu'elle ne soit pas vide.

Merci d'avance !

Bonjour,

à tester,

Range("A1") = ActiveSheet.Shapes(1).TextFrame.Characters.Text

Bonjour, j'ai testé en remplaçant :

'###### Diamètre et marnage ######
    If CS.Sheets(i).TextBox("Zone Texte 2064").Value <> "" Then
        OD.Cells(n, "D") = CS.Sheets(i).TextBox("Zone Texte 2064").Value
    End If

Par

'###### Diamètre et marnage ######
    If CS.Sheets(i).TextBoxes("Text Box 2064").Value <> "" Then
        OD.Cells(n, "D") = CS.Sheets(i).TextFrame.Characters.Text
    End If

Mais j'obtiens l'erreur 400 ...

re

CS.Sheets(i).TextBoxes("Text Box 2064").Value --> pas bon

remplacer par

CS.Sheets(i).Shapes("Text Box 2064").TextFrame.Characters.Text

CS.Sheets(i).TextFrame.Characters.Text --> pas bon

remplacer par

CS.Sheets(i).Shapes("????????").TextFrame.Characters.Text

-

Merci ! Ca fonctionne parfaitement !

Bonne journée!

Rechercher des sujets similaires à "copier contenu zone texte rectangle"