Zones de texte : localisation et récupération de contenu

[DoubleZero]

Bonjour à toutes et à tous,

Lorsqu'un fichier comporte des zones de texte, je souhaiterais, d’abord, si cela est possible , repérer leur emplacement et récupérer leur contenu.

En l’absence de zone de texte, un message indiquant "Aucune zone de texte" (par exemple) pourrait être affiché.

En revanche, si zone(s) de texte il y a, le regroupement pourrait être effectué sur un onglet à créer et appelé « Zones de texte ».

Sur ledit onglet figureraient, alors, les données suivantes :

- nom des onglets concernés par la présence de zones de texte ;
- texte de chaque zone.

Enfin, une seconde macro pourrait, à la demande, supprimer l’ensemble des zones de texte.

J'espère ne pas avoir manqué de clarté et je vous remercie vivement pour votre aide .

 

[Pierrot93]

Re : Zones de texte : localisation et récupération de contenu

Bonjour 00,

regarde ceci, en espérant que cela puisse t'aider à avancer....

Option Explicit
Sub test()
Dim s As TextBox
If Feuil1.TextBoxes.Count = 0 Then MsgBox "aucune textbox...": Exit Sub
For Each s In Feuil1.TextBoxes
    MsgBox Range(s.TopLeftCell.Address, s.BottomRightCell.Address).Address
    MsgBox s.Text
Next s
'supprime toutes les zones de texte
Feuil1.TextBoxes.Delete
End Sub

bon après midi
@+

 

[Hippolite]

Re : Zones de texte : localisation et récupération de contenu

Bonjour 00,
Bonjour Pierrot
Il faudrait préciser ce que comprend la définition de "zones de texte", il y a les textbox, les shapes, les commentaires...
A+

 

[Efgé]

Re : Zones de texte : localisation et récupération de contenu

Bonjour DoubleZero, Pierrot, Hippolite,
Comme j'avais préparé quelque chose je le poste...

Sub Recup_Zone_Text()
Dim F As Worksheet, Sh As Object, K&, TabloReport()
K = 0
For Each F In Worksheets
    If F.Name <> "Zones de texte" Then
        Var = 0
        For Each Sh In F.Shapes
            If Sh.Type = 17 Then
                Var = Var + 1
                K = K + 1
                ReDim Preserve TabloReport(1 To 2, 1 To K)
                TabloReport(1, K) = F.Name
                TabloReport(2, K) = Sh.TextFrame.Characters.Text
            End If
        Next Sh
        If Var = O Then
            K = K + 1
            ReDim Preserve TabloReport(1 To 2, 1 To K)
            TabloReport(1, K) = F.Name
            TabloReport(2, K) = "Aucune zone de texte"
        End If
    End If
Next F
Sheets("Zones de texte").Cells(4, 1).Resize(K, 2) = Application.Transpose(TabloReport)
End Sub

Cordialement

 

[DoubleZero]

Re: Re : Zones de texte : localisation et récupération de contenu

Re-bonjour,

Merci Pierrot, Hippolite, Efgé pour votre aide.

J'espérais

ne pas avoir manqué de clarté

... et j'ai manqué de précision ! Pardon .

Les zones de texte sont insérées grâce à la macro qui m'a gentiment été confectionnée par carcharodon-carcharias.

En voici le code :

Sub Insertion_Zone_De_Texte()
'carcharodon-carcharias
    Dim L!, T!, H!, W!
    'Dimensions et position de la zone de texte
    H = 200    ' hauteur,Height
    W = 400    ' largeur,Width
    L = 100    ' position horizontale,Left
    T = 100    ' position verticale,Top
    'Insertion de la zone de texte
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select
    Selection.Name = "Z1"    '<-- nom de la zone de texte
    With Selection
        .Name = "Z1"    ' Nom de la zone de texte
        .Characters.Text = "" & Chr(10) & ""    ' & Chr(10) &  pour  retour de ligne
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Range("A1").Activate    'sortir de la sélection de la zone de texte
End Sub

Peut-être est-ce la raison pour laquelle la macro de Pierrot n'affiche que "aucune textbox..." et celle de Efgé génère le message "Erreur d'exécution "13" : "Incompatibilité de type", tout en surlignant la ligne "Sheets("Zones de texte").Cells(4, 1).Resize(K, 2) = Application.Transpose(TabloReport)".

Verriez-vous une autre solution, s'il vous plaît ?

A nouveau, je vous remercie pour votre aide .

 

[Efgé]

Re : Zones de texte : localisation et récupération de contenu

Re
Si toutes tes zones sont faites par la macro de C.C (que je salut au passage ), elle porte toute le même nom : "Z1". Donc on pourrais s'appuyer dessus:

Sub Recup_Zone_Text()
Dim F As Worksheet, Sh As Object, K&, TabloReport(), Var&
K = 0
For Each F In Worksheets
    If F.Name <> "Zones de texte" Then
        Var = 0
        For Each Sh In F.Shapes
            If Sh.Name = "Z1" Then
                Var = Var + 1
                K = K + 1
                ReDim Preserve TabloReport(1 To 2, 1 To K)
                TabloReport(1, K) = F.Name
                TabloReport(2, K) = Sh.TextFrame.Characters.Text
            End If
        Next Sh
        If Var = 0 Then
            K = K + 1
            ReDim Preserve TabloReport(1 To 2, 1 To K)
            TabloReport(1, K) = F.Name
            TabloReport(2, K) = "Aucune zone de texte"
        End If
    End If
Next F
If K <> 0 Then _
Sheets("Zones de texte").Cells(4, 1).Resize(K, 2) = _
Application.Transpose(TabloReport)
End Sub

Cordialement

 

[Pierrot93]

Re : Zones de texte : localisation et récupération de contenu

Re,

A priori, le code que je te proposais fonctionne sur le classeur que tu as mis en PJ (feuil a active)...

 

[Hippolite]

Re : Zones de texte : localisation et récupération de contenu

Re,
bonjour Efgé
Rebonjour Pierrot

Tu modifie le code de Efgé avec

        For Each Sh In F.Shapes
            If Sh.Name = "Z1" Then

A+

edit : pas rafraichi, j'ai comme un métro de retard !

 

[DoubleZero]

Re-bonjour,

Merci, Efgé ,

Si toutes tes zones sont faites par la macro de C.C (que je salut au passage ), elle porte toute le même nom : "Z1". Donc on pourrais s'appuyer dessus:

Oui, Efgé, tu as raison et je m'aperçois qu'elles portent toutes le nom "Z1".

A présent, j'ai encore le message "Erreur d'exécution "13" : "Incompatibilité de type" et la ligne

Sheets("Zones de texte").Cells(4, 1).Resize(K, 2) = _
Application.Transpose(TabloReport)

se retrouve surlignée .

Encore merci .

 

[DoubleZero]

Re-bonjour,

Merci, Hippolite,

La modification génère encore le message "Erreur d'exécution "13" : "Incompatibilité de type" et pointe la ligne

Sheets("Zones de texte").Cells(4, 1).Resize(K, 2) = Application.Transpose(TabloReport)

Merci beaucoup .

 

[Efgé]

Re : Zones de texte : localisation et récupération de contenu

Re
En fait je ne comprend pourquoi ça plante. Sur l'exemple la version de Pierrot et la mienne fonctionnent.
Je suis sous 2003.

Ouvre le fichier joint. Mets toi sur n'importe quelle feuille et lance Recup_Zone_Text par alt + F8.
Le tableau va se créer sur la feuille "Zones de texte".
J'ai ajouter une colonne qui récupère le nom des zones traitées (pour voir...)
Essai et dits nous.
Cordialement

 

[DoubleZero]

Re : Zones de texte : localisation et récupération de contenu

Re-bonjour ,

Saperlipopette ! Ça ne veut toujours pas fonctionner ... Serait-ce dû à 2007 ?

Voici le résultat :

Une fois encore... MERCI mais... ne pas hésiter à laisser tomber si... "arrachage de cheveux" en perspective ...

 

[Efgé]

Re : Zones de texte : localisation et récupération de contenu

Re
Avant de partir, juste une question bète... ...tu as bien une feuille "Zones de texte" dans ton fichier ?
Je regarderai chez moi sous 2007 si il y a un problème.
Pour l'instant c'est tout ce que je vois.
Cordialement

 

[DoubleZero]

Re : Zones de texte : localisation et récupération de contenu

Re-bonjour,

Oui, Efgé, j'ai bien cette feuille et le dernier test que j'ai fait portait sur le fichier que tu as pris la peine de joindre à ton précédent message.

Bon retour à la maison et bonne fin de journée .

 

[Efgé]

Re : Zones de texte : localisation et récupération de contenu

Re
Je ne sais pas pourquoi ni comment, mais c'est ton fichier qui pause problème.
En essayant les exemples du fil, il y a bien des plantages (par exemple Excel 2007 refuse le transpose ...)
Par contre si on recrée un fichier neuf, tout marche correctement.
Voir pièce jointe.
Voila c'est tout ce que comprend.
Cordialement