Discussion :

[justgreat]

Bonjour,

J'ai un tableau sur différentes diapo.
Le problème est que sur chaque diapo il a une taille (longueur) légèrement différente.
Pour être plus précis :

sur la diapo 1 : 23,33
sur la diapo 2 : 23,36
sur la diapo 3 : 23,31
sur la diapo 4 : 23,35

Mon but est d'uniformiser la taille sur toutes les diapo à 23,34

J'essaye de le faire, mais ça ne marche pas, si je saisie 23,34 sur la première diapo automatiquement il remet à 23,33 et pareil sur les autres diapo ...
J'ai essayé de fouiller un peu sur les forums, j'ai cru comprendre qu'il faut changer les options de la zone de text à ne pas modifier automatiquement...mais là aussi toutes les options sont désactivées comme le montre la copie d'écran.
Auriez vous une solution ?

Merci d'avance

[Invité]

Bonjour,

Sans garantie.

J'ai repris votre exemple en créant 4 diapos et en créant 1 tableau de 18 cm de haut sur chaque (écran 17"). J'ai ensuite créé une macro pour connaître le rapport de conversion cm / points. Je n'avais pas supprimé les shapes créés par défaut, j'ai donc sélectionné les shapes de type tableau dans la macro :

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
 
Option Explicit
 
Public MonSlide As Slide
Public MaForme As Shape
 
Sub RechercheConversionCmPoints()
 
Dim ConversionCmPoints As Single
' 28,3496
    With ActivePresentation
 
        For Each MonSlide In .Slides
            With MonSlide
                 For Each MaForme In .Shapes
                     If MaForme.Type = 19 Then
                     ConversionCmPoints = MaForme.Height / 18#
                     MsgBox .Name & " : " & MaForme.Name & ", " & MaForme.Height & Chr(10) & ConversionCmPoints
                     End If
                 Next MaForme
            End With
        Next MonSlide
 
    End With
 
 
End Sub

J'ai trouvé un rapport de conversion de 28,3496. Logiquement ce rapport doit être constant sur vos diapos.

J'ai donc ensuite voulu réduire ma hauteur de 18 à 15 cm sur chaque tableau. J'ai utilisé les macros suivantes :

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
 
Sub ModificationTailleShape(ByVal NouvelleHauteurEnCm As Single, ByVal RapportConversion As Single)
 
Dim MaHauteur As Single
' 28,3496
    With ActivePresentation
 
        For Each MonSlide In .Slides
            With MonSlide
                 For Each MaForme In .Shapes
                     If MaForme.Type = 19 Then
                     MaHauteur = MaForme.Height
                     MaForme.Height = MaHauteur / RapportConversion * NouvelleHauteurEnCm
                    ' MsgBox .Name & " : " & MaForme.Name & ", " & MaForme.Height / RapportConversion
                     End If
                 Next MaForme
            End With
        Next MonSlide
 
    End With
 
 
End Sub
 
Sub EssaiModificationTailleShape()
 
   ModificationTailleShape 15, 28.3496
 
End Sub

J'ai ensuite repassé la première macro pour vérifier la nouvelle taille. Les tableaux sont tous passés à 15 cm. Il vous suffirait donc d'adapter ce code pour voir si cela règle votre problème.

Pour installer ces macros : Alt-F11 pour atteindre l'éditeur VBA. Insérer un module et coller les macros.

[Invité]

Pour tenir compte de vos hauteurs différentes, remplacez la première macro par celle-ci :

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
 
Sub RechercheConversionCmPointsV2()
 
Dim ConversionCmPoints As Single
Dim MesHauteurs As Variant
Dim I As Integer
Dim MonRapport As String
 
    MesHauteurs = Array(23.33, 23.36, 23.31, 23.35)
    With ActivePresentation
 
        I = 0
        For Each MonSlide In .Slides
            With MonSlide
                 For Each MaForme In .Shapes
                     If MaForme.Type = 19 Then
                        ConversionCmPoints = MaForme.Height / CSng(MesHauteurs(I))
                        MonRapport = MonRapport & .Name & " : " & MaForme.Name & Chr(10) & "Hauteur en cm : " & MesHauteurs(I) & Chr(10) & "Hauteur en points : " & MaForme.Height & Chr(10) & "Ratio : " & ConversionCmPoints & Chr(10) & Chr(10)
                        I = I + 1
                     End If
                 Next MaForme
            End With
        Next MonSlide
 
        MsgBox MonRapport, vbInformation
 
    End With
 
End Sub

Et les deux autres par celles-ci puisque le rapport est constant :

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
 
 
Sub ModificationTailleShapeV2(ByVal NouvelleHauteurEnCm As Single, ByVal RapportConversion As Single)
 
    With ActivePresentation
 
        For Each MonSlide In .Slides
            With MonSlide
                 For Each MaForme In .Shapes
                     If MaForme.Type = 19 Then MaForme.Height = NouvelleHauteurEnCm * RapportConversion
                 Next MaForme
            End With
        Next MonSlide
 
    End With
 
End Sub
 
Sub EssaiModificationTailleShape()
 
   ModificationTailleShape 23.34, 28.3496 ' Rapport de conversion à adapter
 
End Sub

[AKRAM77]

Bonjour,

J'ai créée un tableau avec les mêmes dimensions ( 3 colonnes et 3 lignes , faut préciser dans ton cas le nombre des colonnes et des lignes pour avoir exactement les mêmes conditions ) ensuite j'ai copié la diapositive et j'ai collé pour avoir une nouvelle et même une troisième et toujours les mêmes dimensions rien ne change , est ce que tu peux m'envoyer tes diapositives pour les essayer de comprendre le problème davantage

[justgreat]

Bonjour et Merci beaucoup pour vos efforts.
Ma question n'était pas en vba mais plus simple que ça et en powerpoint...
En tout cas quelqu'un sur le forum anglais de Microsoft m'a répondu, et la solution est simple, je partage comme ça si quelqu'un tombe sur le même problème ça pourra l'aider.

il m'a dit d'essayer de changer les valeurs à partir du Menu Outils de Tableau, Disposition et ça a fonctionné.



Merci encore une fois pour vos efforts