Macro pour selection de la première ligne d'une zone de texte

Version imprimable

13/10/2020, 12h18
Jodko

Macro pour selection de la première ligne d'une zone de texte

Bonjour,

J'aurais besoin de modifier une macro qui permet de créer un sommaire à partir du texte présent dans une zone de texte identifiée comme titre.

Mon soucis est qu'actuellement, la macro copie/colle l'ensemble du texte présent dans la zone de texte, et j'aimerais qu'elle se limite à la première ligne du texte présent dans la zone.

La ligne de code en question est la suivante :

Code:

ActivePresentation.Slides(2).Shapes(2).TextFrame.TextRange = ActivePresentation.Slides(2).Shapes(2).TextFrame.TextRange & Diapo.SlideIndex & Chr(9) & Diapo.Shapes.Title.TextFrame.TextRange.Text & vbNewLine

Qu'est ce qu'il faudrait modifier pour pouvoir transformer "Diapo.Shapes.Title.TextFrame.TextRange.Text" (qui me semble être la source) pour pouvoir ne prendre que la première ligne ?

Merci !

Jodko.

Citation:

Envoyé par Jodko

Bonjour,

Que donne ce code sur votre présentation ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub TestContenuPremiereLigne()
 
Dim I As Integer
 
     With ActivePresentation
          For I = 1 To .Slides.count
              Debug.Print "Slide : " & I & ", " & PremiereLigneTitle(I)
          Next I
     End With
 
End Sub
 
 
 
Function PremiereLigneTitle(ByVal SlideTeste As Integer) As String
 
Dim TexteShape As Variant
 
    PremiereLigneTitle = ""
    With ActivePresentation.Slides(SlideTeste)
         If .Shapes.HasTitle Then
            With .Shapes.Title
                 If .HasTextFrame Then
                    TexteShape = Split(.TextFrame.TextRange, Chr(11))
                    If UBound(TexteShape) > 0 Then PremiereLigneTitle = TexteShape(0)
                 End If
            End With
         End If
    End With
 
 
End Function

14/10/2020, 10h02
Jodko

Bonjour,

La boucle avec le débug print n'affiche rien, par contre, j'ai mis un espion sur le retour de la fonction a l'air de marcher.

Du coup, j'ai essayé d'appeler la fonction dans le corps de ma propre macro, mais je n'arrive pas à trouver le bon argument.

Jodko.

Citation:

Envoyé par Jodko

Le fonction ne récupère la première ligne qu'en présence d'un retour chariot. La fonction modifiée ci-dessous, récupère également tout le texte s'il n'y a pas de retour chariot :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
 
Function PremiereLigneTitle(ByVal SlideTeste As Integer) As String
 
Dim TexteShape As Variant
 
    PremiereLigneTitle = ""
    With ActivePresentation.Slides(SlideTeste)
         If .Shapes.HasTitle Then
            With .Shapes.Title
                 If .HasTextFrame Then
                    TexteShape = Split(.TextFrame.TextRange, Chr(11))
                    If UBound(TexteShape) > 0 Then
                       PremiereLigneTitle = TexteShape(0)
                    Else
                     PremiereLigneTitle = .TextFrame.TextRange
                    End If
                 End If
            End With
         End If
    End With
 
 
End Function