IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA PowerPoint Discussion :

Mise en Forme de texte par VBA [PPT-2007]


Sujet :

VBA PowerPoint

  1. #1
    Candidat au Club
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2013
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Service public

    Informations forums :
    Inscription : Janvier 2013
    Messages : 3
    Points : 4
    Points
    4
    Par défaut Mise en Forme de texte par VBA
    Bonjour.

    Je suis actuellement en train de développer une interface via Excel pour mettre à jour un PPt de façon automatique.
    L'objectif est de récupérer dans différentes colonnes d'Excel les valeurs à mettre à jour dans différentes zones de texte nommées dans une diapositive.
    Si l'envoi des valeurs vers les zones de texte ne me pose pas de problème, je bute sur leur mise en forme.
    Je cherche en fonction de l'existence ou non de la valeur, à modifier une partie de la couleur du texte final.

    Voici le code que j'utilise :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    Sub MajCarte()
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    ' Génération des variables
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Dim Wb As Workbook                             ' Ce classeur
    Dim Chemin As String, Pres As String           ' Emplacement réseau, Nom du PPt
    Dim PptApp As PowerPoint.Application           ' Déclaration de l'application PowerPoint
    Dim PptDoc As PowerPoint.Presentation          ' Déclaration du PPt
    Dim objSld As PowerPoint.Slide                 ' va permettre de parcourir les diapositives du diaporama
    Dim objShp As PowerPoint.Shape                 ' va permettre de parcourir les éléments d'une diapositive
    Dim strNom As String                           ' valeur du nouveau nom
    Dim a As Variant, b As Variant                   ' variables servant à stocker les valeurs à mettre dans les shapes
    Dim c As Variant, d As Variant                   ' variables servant à stocker les valeurs à mettre dans les shapes
    Dim rnNom As Range, rnCell As Range            ' Plage de cellules contenant le nom des shapes
    Dim z as Single                                        ' Compteur
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
     
    Set Wb = ActiveWorkbook
    Chemin = Wb.Path
    Pres = "CARTE.pptx"
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     
    'Ouverture de l'instance Powerpoint xxxxxxxxxxxxxxxxxxxxxxx
    Set PptApp = CreateObject("Powerpoint.Application")
    PptApp.Visible = True
     
    Set PptDoc = PptApp.Presentations.Open(Chemin & "\" & Pres, WithWindow:=msoFalse)
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
     
    Sheets("Temp").Activate
     
    'Initialisation de la valeur du z
    Range("A1").Offset.End(xlDown).Select
    z = ActiveCell.Row
     
    'Récupération des valeurs pour mise à jour
     
    With ActiveSheet
        Set rnNom = Range(Range("A2"), Range("A" & z)) '.End(xlDown))
     
        For Each rnCell In rnNom
        rnCell.Select
        a = ActiveCell.Value              'Nom de la forme à chercher dans le PPt
        b = ActiveCell.Offset(0, 4).Value 'Nom (valeur de remplacement) de la commune
        c = ActiveCell.Offset(0, 5).Value 'Km S1
        d = ActiveCell.Offset(0, 6).Value 'Km S23
     
    'Génération du texte de remplacement et envoi vers la carte
     
            With PptDoc.Slides(1).Shapes(a)
     
                Select Case c
                    Case Is = ""
                        If d <> "" Then
                            .TextFrame.TextRange.Text = d & vbCrLf & b
                        End If
                        If d = "" Then
                            .TextFrame.TextRange.Text = b
                        End If
                    Case Is <> ""
                        If d <> "" Then
                            .TextFrame.TextRange.Text = c & " - " & d & vbCrLf & b
                        End If
                        If d = "" Then
                            .TextFrame.TextRange.Text = c & vbCrLf & b
                        End If
                End Select
     
            End With
     
    ' C'est ici que je bloque car je souhaite passer une mise en forme dédiée à chaque variable b, c et d.
    ' Cette mise en forme ci dessous ne gère que la zone en entier
     
            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange
                ' modification de la police
                .Font.Name = "Calibri"
                .Font.Bold = msoTrue
                .Font.Size = 8
                .Font.Color = 0
            End With
            With PptDoc.Slides(1).Shapes(a)
                'centrage de la police
                .TextEffect.Alignment = msoTextEffectAlignmentCentered
            End With
     
        Next
    End With
     
     
    'Sauvegarde la présentation dans le même répertoire que le classeur excel contenant la macro.
     
    PptDoc.SaveAs Filename:=Wb.Path & "\" & Pres
     
    'ferme la présentation
    PptDoc.Close
    'ferme powerpoint
    PptApp.Quit
     
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
     
     
    MsgBox "L'opération de mise à jour de la carte est terminée."
     
    End Sub
    Ce que je cherche à faire mais sans y arriver c'est de mettre de couleurs différentes le texte correspondant aux variables b,c et d.
    Par exemple d en bleu, c en rouge et b en noir.

    Je vous remercie par avance de votre aide qui me sera très précieuse.
    Amicalement.

    Je vous joins les deux fichiers me servant à cette réalisation :
    Fichiers attachés Fichiers attachés

  2. #2
    Candidat au Club
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2013
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Service public

    Informations forums :
    Inscription : Janvier 2013
    Messages : 3
    Points : 4
    Points
    4
    Par défaut Résolu...
    En fait il fallait gérer la longueur du texte et utiliser "TextRange.Characters"...

    je vous livre donc ici si cela peut servir à d'autres le moyen de gérer le mode multicolore de la police dans une shape :

    je génère une variable LgX qui calcule la longueur du texte :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    With ActiveSheet
        Set rnNom = Range(Range("A2"), Range("A" & z))
     
        For Each rnCell In rnNom
        rnCell.Select
        a = ActiveCell.Value              'Nom de la forme à chercher dans le PPt
        LgA = Len(a)
        b = ActiveCell.Offset(0, 4).Value 'Nom (valeur de remplacement) de la commune
        LgB = Len(b)
        c = ActiveCell.Offset(0, 5).Value 'Km S1
        LgC = Len(c)
        d = ActiveCell.Offset(0, 6).Value 'Km S23
        LgD = Len(d)
    Ensuite il suffit de ne pas se tromper dans le calcul du nombre de caractères sur lesquels il faut appliquer un code couleur...
    Attention, vu que j'ai besoin d'écrire sur deux lignes j'utilise le "vbCrLf" qui compte comme 1 caractère.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    'Génération du texte de remplacement et mise en forme
            With PptDoc.Slides(1).Shapes(a)
     
                Select Case c
                    Case Is = ""
                        If d <> "" Then
                            .TextFrame.TextRange.Text = d & " " & vbCrLf & b
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=1, Length:=LgD)
                                .Font.Bold = msoFalse
                                .Font.Color = -16776961 'rouge -65536 'bleu
                            End With
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=LgD + 3, Length:=LgB)
                                .Font.Bold = msoTrue
                                .Font.Color = RGB(205, 25, 171) 'Violet
     
                            End With
                        End If
                        If d = "" Then
                            .TextFrame.TextRange.Text = b
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=1, Length:=LgB)
                                .Font.Bold = msoFalse
                                .Font.Color = RGB(205, 25, 171) 'Violet
                            End With
                        End If
                    Case Is <> ""
                        If d <> "" Then
                            .TextFrame.TextRange.Text = c & " - " & d & vbCrLf & b
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=1, Length:=LgC)
                                .Font.Bold = msoFalse
                                .Font.Color = -65536 'bleu -16776961 'rouge
                            End With
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=LgC + 4, Length:=LgD)
                                .Font.Bold = msoFalse
                                .Font.Color = -16776961 'rouge -65536 'bleu
                            End With
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=LgC + 3 + LgD + 2, Length:=LgB)
                                .Font.Bold = msoTrue
                                .Font.Color = RGB(205, 25, 171) 'Violet
                            End With
                        End If
                        If d = "" Then
                            .TextFrame.TextRange.Text = c & vbCrLf & b
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=1, Length:=LgC)
                                .Font.Bold = msoFalse
                                .Font.Color = -65536 'bleu -16776961 'rouge
                            End With
                            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange.Characters(Start:=LgC + 2, Length:=LgB)
                                .Font.Bold = msoTrue
                                .Font.Color = RGB(205, 25, 171) 'Violet
                            End With
                        End If
                End Select
            End With
            With PptDoc.Slides(1).Shapes(a).TextFrame.TextRange
    ' modification de la police
                .Font.Name = "Calibri"
                .Font.Size = 8
            End With
            With PptDoc.Slides(1).Shapes(a)
    'centrage de la police
                .TextEffect.Alignment = msoTextEffectAlignmentCentered
            End With
        Next
    End With
    Ce code est donc à adapter en fonction de vos besoins car ici j'avais besoin de vérifier l'existence ou non d'une valeur dans chaque cellule Excel.
    Bon courage à vous.

    Amicalement.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Mise en forme conditionnelle >3 par VBA
    Par mouftie dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 06/02/2013, 19h37
  2. [XL-2007] Mise en forme avant impression par vba
    Par ..ooooOö.. dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 27/11/2011, 22h52
  3. texte mise en forme après accès par signet word
    Par dederfred dans le forum Delphi
    Réponses: 5
    Dernier message: 11/11/2006, 22h19
  4. Mise en forme table access par VBA ou SQL
    Par romrai dans le forum Requêtes et SQL.
    Réponses: 4
    Dernier message: 21/02/2006, 13h29
  5. [CRYSTAL REPORT 8.5] Mise en forme du texte par balises
    Par GyLes dans le forum SAP Crystal Reports
    Réponses: 2
    Dernier message: 08/11/2005, 10h35

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo