Discussion :

[rouchi]

Bonjour,

Je bosse sur un nouveau projet de création de devis dans l'event.
Mon souci, c'est les devis qui seront générés doivent être en .pptx, car les clients souhaitent les modifier pour leurs clients à eux.

Est-ce possible d'après vous ?

Merci pour votre précieuse aide.

[loufab]

Bonjour,

Powerpoint, Word, Excel aucun problème. Il suffit de passer par l'automation (pilotage de d'un produit VBA depuis un autre produit VBA).

Du coup il te faut voir coté Powerpoint-VBA et non ACCESS-VBA car lui n'envoie que des données dans le modèle VBA-Powerpoint.

Cordialement,

[rouchi]

Bonjour,

Merci pour votre réponse.

Je vais faire des recherches dans ce sens, mais sans être certain que c'est dans cette direction que je dois commencer.

Car, les données viennent du futur outil que je vais développer sur Access. Et ses mêmes données je souhaite les "Imprimer" dans un PPT avec une mise en page définie, comme si je remplace l'état pas une slide.

[loufab]

A part l'automation vous pouvez souscrire un abonnement à un complément qui fait le job (google est votre ami).

Sinon je ne vois pas qu'elle autre direction vous souhaitez prendre, si c'est bien une automatisation du process que vous souhaitez.

[rouchi]

Un abonnement à un complément ?

Tiens donc ! Cela m'intéresse. Vous pouvez m'en dire plus svp.

[loufab]

https://www.presentationpoint.com/software/datapoint/

Ensuite il faut voir le cout à long terme par rapport à une solution développée.

[rouchi]

Bonsoir,

Je bloque et je ne comprends pas ce qui se passe.

Je souhaite créer une zone de texte dans un ppt à partir d'access. Mais j'ai constament un message d'erreur :

erreur d'execution -2147024809 (80070057) la valeur tapée est en dehors des limites

Voici mon code

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
Private Sub Commande65_Click()
 
 
 
    Dim ppt As PowerPoint.Application
    Dim presentation As PowerPoint.presentation
    Dim slide As PowerPoint.slide
    Dim shape1 As PowerPoint.shape
    Dim shape2 As PowerPoint.shape
    Dim valeurChamp1 As String
    Dim valeurChamp2 As String
 
    ' Prendre les valeurs des champs courants dans le formulaire
    valeurChamp1 = Me.nom_ctact.Value
    valeurChamp2 = Me.nom_clt.Value
 
    ' Ouvrir PowerPoint
    Set ppt = New PowerPoint.Application
    ppt.Visible = True
 
    ' Ouvrir la présentation
    Set presentation = ppt.Presentations.Open("C:\Users\Malek\Documents\test2.pptx")
 
    ' Accéder à la diapositive 3
    Set slide = presentation.Slides(2)
 
    ' Créer une nouvelle zone de texte pour chaque champ et y insérer la valeur du champ
    Set shape1 = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=215, Height:=130)
    shape1.TextFrame.TextRange.Text = valeurChamp1
 
    Set shape2 = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=100, Top:=200, Width:=200, Height:=50)
    shape2.TextFrame.TextRange.Text = valeurChamp2
 
 
 
End Sub

L'erreur me pointe cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set shape1 = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=215, Height:=130)

J'ai beau modifier l'emplacement rien ne fait.

Please HELP

[hyperion13]

Salut
Depuis quand ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    ' Accéder à la diapositive 3
    Set slide = presentation.Slides(2)

l'indice (2) égale à la 2ème diapositive de votre diaporama !

[rouchi]

Bonsoir,

Oui Oui, c'est bien la slide 2 que je pointe.

[rouchi]

Rien de change, toujours ce maudit message d'erreur

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
Private Sub Commande65_Click()
 
    Dim ppt As PowerPoint.Application
    Dim presentation As PowerPoint.presentation
    Dim slide As PowerPoint.slide
    Dim shape1 As PowerPoint.shape
    Dim shape2 As PowerPoint.shape
    Dim valeurChamp1 As String
    Dim valeurChamp2 As String
 
    ' Prendre les valeurs des champs courants dans le formulaire
    valeurChamp1 = Me.nom_ctact.Value
    valeurChamp2 = Me.nom_clt.Value
 
 
    ' Ouvrir PowerPoint
    Set ppt = New PowerPoint.Application
    ppt.Visible = True
 
    ' Ouvrir la présentation
    Set presentation = ppt.Presentations.Open("C:\Users\Malek\Documents\test2.pptx")
 
    ' Accéder à la diapositive 2
    Set slide = presentation.Slides(2)
 
    ' Créer une nouvelle zone de texte pour chaque champ et y insérer la valeur du champ
    Set shape1 = slide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=100, Width:=200, Height:=50)
    shape1.TextFrame.TextRange.Text = valeurChamp1
 
    Set shape2 = slide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=100, Top:=200, Width:=200, Height:=50)
    shape2.TextFrame.TextRange.Text = valeurChamp2
 
End Sub

[rouchi]

[QUOTE=hyperion13;11948032]Salut
Depuis quand ?

Je suis en train de monter mon outil. Ce code n'a jamais marché. Je viens d'y consacrer toute mon après-midi.

[hyperion13]

salut
pour ma part ça fonctionne

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
Private Sub btnppt_Click()
Dim appPpt As PowerPoint.Application
Dim docPpt As PowerPoint.Presentation
Dim objSld As PowerPoint.Slide, objSld1 As PowerPoint.Slide
Dim var1 As String, var2 As String
 
var1 = Me.Texte1
var2 = Me.Texte2
 
Set appPpt = New PowerPoint.Application
appPpt.Visible = True
 
Set docPpt = appPpt.Presentations.Open(CurrentProject.Path & "\" & "20230524_ppt.pptx")
 
Set objSld = docPpt.Slides(2)
objSld.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=215, Height:=130).TextFrame.TextRange.Text = var1
 
Set objSld1 = docPpt.Slides(2)
objSld1.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=10, Top:=50, Width:=215, Height:=130).TextFrame.TextRange.Text = var2
 
End Sub

[loufab]

Bonjour,

Visiblement tu peux factoriser ton code, cette partie étant identique :

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
 
'shape 3
    Set shape3 = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=341.334, Top:=162.446, Width:=255.118, Height:=19.845)
    shape3.TextFrame.TextRange.Text = vc3
 
 
    With shape3.TextFrame.TextRange.Font
        .Size = 10
        .Name = "Century Gothic"
        .Color.RGB = RGB(0, 0, 0)
    End With
 
    shape3.TextFrame.TextRange.Paragraphs(1).Characters(1, 27).Font.Bold = msoTrue
 
 
    shape3.TextFrame2.TextRange.ParagraphFormat.Alignment = ppAlignCenter

Cordialement,

[rouchi]

Bonjour,

C'est à dire ? que tu dis factoriser...

[loufab]

Factoriser du code :
https://ensweb.users.info.unicaen.fr/tuto/css/

[rouchi]

Bonjour,

Mon projet avance mais je sèche sur une action et j'arrive pas à trouver la solution.

Je souhaite depuis mon formulaire, j'ai un menu deroulant. Je veux selon le choix du menu rendre visible le champ d'un sous-formulaire.
Mais j'ai une erreur d'exe 438. Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub selectedPrice_AfterUpdate()
 
    If Me.selectedPrice.Value = "Tarif Client1" Then
        Me.fille129.Form.p_client2.Visible = False
    End If
 
End Sub

[rouchi]

J'ai trouvé !!!

Merci

[rouchi]

Bonsoir la communauté

J'ai un problème sur l'export d'une slide. La 6 pour être précis.

Mon objectif :

Je veux exporter des Familles, puis en dessous les articles de cette famille et sous ces articles les photos des produits.
les photos doivent être alignées les une à côté des autres avec un espacement dont les paramètres sont dans un module. Le module identifie si l'image est en portrait ou en paysage ce qui va
donner l'espace en le dernier article et la photo.
Le tout dans une boucle. Pour les changements de familles.

Mon problème c'est le positionnement horizontale des images.
Elles ne se placent pas sous le dernier article. J'ai l'impression que les images tienne compte de la famille pour se positionner.
Et je ne trouve pas la solution.

Voici le code (enfin la partie de la slide 6) puis le module.

Please Help

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
109
'slide6
 
    sourcePresentation.Slides(6).Copy
    destinationPresentation.Slides.Paste
 
 
    Set slide = destinationPresentation.Slides(6)
 
 
' Exécutez la requête SQL
Dim strSQL As String
Dim sfamSpacing As Single
Dim nam_art As String
Dim img As Boolean
Dim imag As String
Dim imgShape As shape
Dim firstImageLeftPosition As Single
Dim imgPosition As Single
 
 
strSQL = "SELECT sfam, nam_art, img, imag FROM r_exp_art_prest WHERE id_aff = " & id_aff & " ORDER BY order2"
 
' Ouvrez un enregistrement recordset
Set rs = db.OpenRecordset(strSQL)
 
 
expSfam = ""
topPosition = 100 ' À ajuster selon votre mise en page
imgPosition = topPosition + 12
sfamSpacing = 70 ' Valeur de l'espace supplémentaire entre chaque sfam
firstImageLeftPosition = 74.844
 
' Parcourez les enregistrements résultants de la requête
 
 
Do While Not rs.EOF
 
    sfam = rs!sfam
    nam_art = rs!nam_art
    img = rs!img
    imag = rs!imag
 
    ' Si la valeur de sfam change, créer une nouvelle catégorie (sfam)
    If sfam <> expSfam Then
        ' Ajouter un espace supplémentaire entre les sfam
        If expSfam <> "" Then
            topPosition = topPosition + sfamSpacing
        End If
 
        ' Afficher le nom de la famille (sfam)
        Set shape = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=74.844, Top:=topPosition, Width:=400, Height:=17.01)
        shape.TextFrame.TextRange.Text = sfam
 
        With shape.TextFrame.TextRange.Font
            .Size = 11
            .Name = "Century Gothic"
            .Color.RGB = RGB(0, 0, 0) ' Rouge: 0, Vert: 0, Bleu: 0
            .Bold = True
        End With
 
        ' Mettre à jour la position verticale
        topPosition = topPosition + 17 ' À ajuster selon votre mise en page
 
        ' Réinitialiser expSfam
        expSfam = sfam
        firstImageLeftPosition = 74.844
        imgPosition = topPosition + 12
    End If
 
    ' Afficher le nom de l'article (nam_art)
    Set shape = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=74.844, Top:=topPosition, Width:=400, Height:=17.01)
    shape.TextFrame.TextRange.Text = nam_art
 
    With shape.TextFrame.TextRange.Font
        .Size = 11
        .Name = "Century Gothic"
        .Color.RGB = RGB(0, 0, 0) ' Rouge: 0, Vert: 0, Bleu: 0
    End With
 
     topPosition = topPosition + 12
 
 
 
' Vérifier si le champ "img" est défini sur "Oui" et afficher l'image
 
 
    If img = True Then
 
        ' Assurez-vous que "imag" contient l'adresse de l'image
        If imag <> "" Then
            ' Créer un objet Image à la position actuelle (leftPosition)
            Set imgShape = slide.Shapes.AddPicture(FileName:=imag, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=firstImageLeftPosition, Top:=imgPosition + CalculateVerticalOffset(imag))
 
 
            ' Mettre à jour la position horizontale pour la prochaine image dans la même famille
            firstImageLeftPosition = firstImageLeftPosition + 60 ' Ajustez cette valeur selon la largeur de vos images
            imgPosition = imgPosition
        End If
    End If
 
 
    ' Mettre à jour la position verticale
    'topPosition = topPosition + 12 ' À ajuster selon votre mise en page
    'imgPosition = imgPosition
 
    rs.MoveNext
Loop
' Fermez le recordset
rs.close

Le module

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
Function CalculateVerticalOffset(imagePath As String) As Single
    ' Cette fonction prend en paramètre le chemin de l'image et renvoie la valeur de décalage vertical en fonction de l'orientation de l'image.
 
    Dim img As Object
    Set img = CreateObject("WIA.ImageFile")
    img.LoadFile (imagePath)
 
    Dim imgWidth As Double
    Dim imgHeight As Double
 
    imgWidth = img.Width
    imgHeight = img.Height
 
    If imgWidth > imgHeight Then
        ' Si l'image est en paysage
        CalculateVerticalOffset = 30
    Else
        ' Si l'image est en portrait
        CalculateVerticalOffset = 60
    End If
End Function

[rouchi]

Bonjour à tous,

J'ai trouvé une solution pour mon problème ci-dessus. Pas le resultat que je souhaitais, mais il n'etait pas possible de le faire.
Mais j'ai réussi à obtenir un resultat secondaire qui passe.

J'ai un autre problème, et j'ai besoin de vos lumières.

voici pour commencer la partie concernée :

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
 'slide6
sourcePresentation.Slides(6).Copy
destinationPresentation.Slides.Paste
 
Set slide = destinationPresentation.Slides(6)
 
' Exécutez la requête SQL
Dim strSQL As String
Dim sfamSpacing As Single
Dim nam_art As String
Dim img As Boolean
Dim imag As String
Dim imgShape As shape
Dim artShape As shape
Dim firstImageLeftPosition As Single
Dim topPositionMax As Single ' Nouvelle variable pour définir la limite de la position verticale
Dim imgPosition As Single
 
 
strSQL = "SELECT sfam, nam_art, img, imag FROM r_exp_art_prest WHERE id_aff = " & id_aff & " ORDER BY order2"
 
' Ouvrez un enregistrement recordset
Set rs = db.OpenRecordset(strSQL)
 
expSfam = ""
topPosition = 100 ' À ajuster selon votre mise en page
sfamSpacing = 60 ' Valeur de l'espace supplémentaire entre chaque sfam
topLeft = 74.844
firstImageLeftPosition = topLeft
topPositionMax = 350 ' Nouvelle variable pour définir la limite de la position verticale
 
' Parcourez les enregistrements résultants de la requête
Do While Not rs.EOF
    sfam = rs!sfam
    nam_art = rs!nam_art
    img = rs!img
    imag = rs!imag
 
    ' Si la valeur de sfam change, créer une nouvelle catégorie (sfam)
    If sfam <> expSfam Then
        ' Vérifier si la position verticale atteint la limite
        If topPosition > topPositionMax Then
            If topLeft = 480 Then
 
                ' Copier la slide 6 du sourcePresentation
                sourcePresentation.Slides(6).Copy
 
                ' Coller la slide copiée à la fin du destinationPresentation
                destinationPresentation.Slides.Paste
 
                ' Définir slide comme étant la dernière diapositive ajoutée
                Set slide = destinationPresentation.Slides(destinationPresentation.Slides.Count)
 
                topPosition = 40 ' Réinitialisation de la position verticale
                topLeft = 74.844 ' Réinitialisation de la position horizontale
 
              End If
 
            ' Exporter le contenu de la famille en réinitialisant la position verticale et horizontale
            topPosition = 40 ' Réinitialisation de la position verticale
            topLeft = 480 ' Réinitialisation de la position horizontale
        End If
 
 
        ' Ajouter un espace supplémentaire entre les sfam
        If expSfam <> "" Then
            topPosition = topPosition + sfamSpacing
        End If
 
        ' Afficher le nom de la famille (sfam)
        Set shape = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=topLeft, Top:=topPosition, Width:=400, Height:=17.01)
        shape.TextFrame.TextRange.Text = sfam
 
        With shape.TextFrame.TextRange.Font
            .Size = 11
            .Name = "Century Gothic"
            .Color.RGB = RGB(0, 0, 0) ' Rouge: 0, Vert: 0, Bleu: 0
            .Bold = True
        End With
 
        ' Mettre à jour la position verticale
        topPosition = topPosition + 20 ' À ajuster selon votre mise en page
 
        ' Réinitialiser expSfam
        expSfam = sfam
        firstImageLeftPosition = topLeft ' Réinitialisation de la position horizontale
 
    End If
 
    ' Afficher le nom de l'article (nam_art)
    Set artShape = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=topLeft, Top:=topPosition, Width:=400, Height:=17.01)
    artShape.TextFrame.TextRange.Text = nam_art
 
    With artShape.TextFrame.TextRange.Font
        .Size = 11
        .Name = "Century Gothic"
        .Color.RGB = RGB(0, 0, 0) ' Rouge: 0, Vert: 0, Bleu: 0
    End With
 
    imgPosition = topPosition + artShape.Height
 
    topPosition = topPosition + 12
 
    ' Vérifier si le champ "img" est défini sur "Oui" et afficher l'image
    If img = True Then
 
        ' Assurez-vous que "imag" contient l'adresse de l'image
        If imag <> "" Then
            ' Créer un objet Image à la position actuelle (leftPosition)
            Set imgShape = slide.Shapes.AddPicture(FileName:=imag, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=firstImageLeftPosition, Top:=imgPosition + CalculateVerticalOffset(imag))
 
            ' Mettre à jour la position horizontale pour la prochaine image dans la même famille
            firstImageLeftPosition = firstImageLeftPosition + 60 ' Ajustez cette valeur selon la largeur de vos images
 
        End If
 
    End If
 
    ' Mettre à jour la position verticale
    'topPosition = topPosition + 12 ' À ajuster selon votre mise en page
 
    rs.MoveNext
Loop
 
' Fermez le recordset
rs.close

dans cette partie plus précise :

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
' Si la valeur de sfam change, créer une nouvelle catégorie (sfam)
    If sfam <> expSfam Then
        ' Vérifier si la position verticale atteint la limite
        If topPosition > topPositionMax Then
            If topLeft = 480 Then
 
                ' Copier la slide 6 du sourcePresentation
                sourcePresentation.Slides(6).Copy
 
                ' Coller la slide copiée à la fin du destinationPresentation
                destinationPresentation.Slides.Paste
 
                ' Définir slide comme étant la dernière diapositive ajoutée
                Set slide = destinationPresentation.Slides(destinationPresentation.Slides.Count)
 
                topPosition = 40 ' Réinitialisation de la position verticale
                topLeft = 74.844 ' Réinitialisation de la position horizontale
 
              End If
 
            ' Exporter le contenu de la famille en réinitialisant la position verticale et horizontale
            topPosition = 40 ' Réinitialisation de la position verticale
            topLeft = 480 ' Réinitialisation de la position horizontale
        End If

la première condition fonctionne,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If topPosition > topPositionMax Then
            ' Exporter le contenu de la famille en réinitialisant la position verticale et horizontale
            topPosition = 40 ' Réinitialisation de la position verticale
            topLeft = 480 ' Réinitialisation de la position horizontale
        End If

Mais en ce qui concerne la seconde

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
If topLeft = 480 Then
 
                ' Copier la slide 6 du sourcePresentation
                sourcePresentation.Slides(6).Copy
 
                ' Coller la slide copiée à la fin du destinationPresentation
                destinationPresentation.Slides.Paste
 
                ' Définir slide comme étant la dernière diapositive ajoutée
                Set slide = destinationPresentation.Slides(destinationPresentation.Slides.Count)
 
                topPosition = 40 ' Réinitialisation de la position verticale
                topLeft = 74.844 ' Réinitialisation de la position horizontale
 
              End If

J'ai bien la nouvelle slide qui s'ajoute, mais dans cette nouvelle slide le topLeft reste à 480 au lieu de passer à 74.844.

J'ai essayé cette option

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
If topPosition > topPositionMax And topLeft = 480 Then
 
                ' Copier la slide 6 du sourcePresentation
                sourcePresentation.Slides(6).Copy
 
                ' Coller la slide copiée à la fin du destinationPresentation
                destinationPresentation.Slides.Paste
 
                ' Définir slide comme étant la dernière diapositive ajoutée
                Set slide = destinationPresentation.Slides(destinationPresentation.Slides.Count)
 
                topPosition = 40 ' Réinitialisation de la position verticale
                topLeft = 74.844 ' Réinitialisation de la position horizontale
 
              End If

J'ai le même resulat. le topLeft ne passe pas à 74.844.

Quelqu'un aurait une idée ??

J'ai passé trop de temps sur ce problème mais je ne trouve pas !!

Please HELP