Progression

Bonjour,

J'utilise ce code sous PowerPoint mais je ne comprend pas pourquoi dans ma barre, j'ai un rectangle et en plus, il est encadré avec une couleur plus foncé ?

J'aimerais n'avoir que le rectangle sans aucun contour

Voici le code :

Sub AddProgressBar()

On Error Resume Next

With ActivePresentation

For X = 1 To .Slides.Count

.Slides(X).Shapes("PB").Delete

Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, _

0, .PageSetup.SlideHeight - 540, _

X * .PageSetup.SlideWidth / .Slides.Count, 10)

s.Fill.ForeColor.RGB = RGB(255, 0, 0)

s.Name = "PB"

Next X:

End With

End Sub

Merci

Sub AddProgressBar()
On Error Resume Next
With ActivePresentation
For X = 1 To .Slides.Count
.Slides(X).Shapes("PB").Delete
Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, 0, .PageSetup.SlideHeight - 540, X * .PageSetup.SlideWidth / .Slides.Count, 10)
s.Fill.ForeColor.RGB = RGB(255, 0, 0)
s.Line.Visible = False
s.Name = "PB"
Next X:
End With
End Sub

La seule ligne ajoutée:

s.Line.Visible = False

Énorme merci pour la réponse rapide.

J'aurais également voulu demander, mais la c'est un peu le Saint Graal, est-ce vous savez comment on peut faire pour insérer un pourcentage qui est centré dans le rectangle, de taille 10 avec l'écriture Time New Roman en fonction du nombre de diapositive.

Par exemple je sais que si j'ai 20 diapos, pour arrivé à 100%, il me faudra compter de 5 en 5.

Encore merci pour l'aide apporté.

Je me demande, si cela est possible

Sub AddProgressBar()
On Error Resume Next
Dim pourcentage As Integer
With ActivePresentation
For x = 1 To .Slides.Count
pourcentage = CInt((x / .Slides.Count) * 100)
.Slides(x).Shapes("PB").Delete
Set s = .Slides(x).Shapes.AddShape(msoShapeRectangle, 0, .PageSetup.SlideHeight - 540, x * .PageSetup.SlideWidth / .Slides.Count, 10)
s.Fill.ForeColor.RGB = RGB(255, 0, 0)

s.Line.Visible = False
s.TextFrame.FontName = "Times New Roman"
s.TextFrame.FontSize = 10
s.TextFrame.TextRange.Text = pourcentage & "%"
s.Name = "PB"
Next x:
End With
End Sub

Franchement, je vous remercie beaucoup pour l'aide que vous m'avez apporté, cela m'a permis de faire ce que je voulais faire à la base mais en mieux.

Par contre seul problème, la taille n'est pas de 10 mais de 16 pourtant c'est bien écrit 10 dans le code, j'ai beau mettre plein de taille différente, cela ne change rien.

Merci

haha désolé une erreur de ma part ^^

Sub AddProgressBar()
On Error Resume Next
Dim pourcentage As Integer
With ActivePresentation
For x = 1 To .Slides.Count
pourcentage = CInt((x / .Slides.Count) * 100)
.Slides(x).Shapes("PB").Delete
Set s = .Slides(x).Shapes.AddShape(msoShapeRectangle, 0, .PageSetup.SlideHeight - 540, x * .PageSetup.SlideWidth / .Slides.Count, 10)
s.Fill.ForeColor.RGB = RGB(255, 0, 0)

s.Line.Visible = False
s.TextEffect.FontName = "Times New Roman"
s.TextEffect.FontSize = 10
s.TextFrame.TextRange.Text = pourcentage & "%"
s.Name = "PB"
Next x:
End With
End Sub
 

C'est plutôt moi qui devrait m'excuser de vous déranger avec mes questions.

En tout cas, je vous remercie une nouvelle fois pour votre aide et je vous souhaite une bonne fin de journée.

Rechercher des sujets similaires à "progression"