Discussion :

[hedidev1]

Bonjour, mes codes ne fonctionnent pas avec les .docx mais seulement avec les .doc.

Que faire ?

Merci !

[mercatog]

Ne fonctionnent pas ne veut rien dire. Tu as une erreur, si oui laquelle.

[hedidev1]

Bonjour mercatog, au fait le programme ne fait rien. L'execution se fait mais rien ne s'ecrit.

J'ai fait des tests, j'ouvre 2 documents word un Doc1.docx et un Doc1.doc. Je lance le programme, 2 fois, sur chacun des documents, et "quand il veut" il ecrit 2 fois sur le meme document.

Merci pour votre aide (meme probleme en ppt)

Autre test: Ca ne marche pas avec un document ancien, j'en crée un nouveau je l'enregistre et ca marche...

[clementmarcotte]

Bonjour,

Aujourd'hui, ma boule de cristal va peut-être marcher

Bonjour mercatog, au fait le programme ne fait rien. L'execution se fait mais rien ne s'ecrit.

J'ai fait des tests, j'ouvre 2 documents word un Doc1.docx et un Doc1.doc. Je lance le programme, 2 fois, sur chacun des documents, et "quand il veut" il ecrit 2 fois sur le meme document.

Donc, ta macro utilise peut-être un "ThisDocument" quand il ne faut pas. ThisDocument en Word, c'est comme ThisWorkboox en Excel. Ils désignent uniquement le fichier qui contient la macro.

(meme probleme en ppt)

Sauf horreur de ma part, pour qu'une macro PPT puis zigonner dans une autre présentation que celle qui la contient, elle doit être utilisée comme complément depuis PPT 2007 ou macro complémentaire pour PPT 2003 et avant.

P.S. Si ton code est trop secret pour être montré, cela ne vaut probablement pas la peine de venir sur un forum.

[hedidev1]

Bonjour! Merci pour votre aide.

Voici le 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
37
38
39
40
41
42
43
44
45
Function bPptCreate(oPptDoc As Object, bNewPres As Boolean, Optional sChemin As String) As Boolean
 
    Dim oPptApp As Object
 
    bPptCreate = True
 
    On Error GoTo errorHandler
 
    If bNewPres = True Then
        Set oPptApp = CreateObject("Powerpoint.Application")
        Set oPptDoc = oPptApp.Presentations.Add
        oPptApp.Visible = True
        oPptDoc.Save
    ElseIf bNewPres = False Then
        Set oPptDoc = GetObject(sChemin)
        End If
 
Exit Function
 
errorHandler:
    bPptCreate = False
 
End Function
 
Function bPptAddSlides(oPptDoc As Object, sDesign As String, sLayout As String) As Boolean
 
bPptAddSlides = True
 
On Error GoTo errorHandler
oPptDoc.Slides.Add Index:=oPptDoc.Slides.Count + 1, Layout:=ppLayoutText 'oPptDoc.Designs(1).SlideMaster.CustomLayouts(1)
 
oPptDoc.Slides(oPptDoc.Slides.Count).Shapes.Title.TextFrame.TextRange.Text = "titre"
oPptDoc.Slides(oPptDoc.Slides.Count).Shapes(2).TextFrame.TextRange.Text = "text"
 
Exit Function
errorHandler:
    bPptAddSlides = False
End Function
 
Dim oexpppt As Object
 
Sub test()
bPptCreate oexpppt, False, "C:\Users\K010354\Desktop\testt.pptx"
bPptAddSlides oexpppt, "", ""
End Sub

Et le code (partiel) pour word:

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
 
Function bWordCreate(oWdDoc As Object, bNewDoc As Boolean, Optional sChemin _
                     As String) As Boolean
 
    Dim oWdApp As Object
 
    bWordCreate = True
 
    On Error GoTo errorHandler
 
    If bNewDoc = True Then
        Set oWdApp = CreateObject("Word.Application")
        oWdApp.Visible = True
        Set oWdDoc = oWdApp.Documents.Add
        oWdDoc.Save
    ElseIf bNewDoc = False Then
        Set oWdDoc = GetObject(sChemin)
    End If
 
Exit Function
 
errorHandler:
    bWordCreate = False
 
End Function
 
 
Function bWordTypeWithStyle(oWdDoc As Object, sTexte As String, _
                            sStyle As String, Optional sSignet As String) _
                            As Boolean
 
    bWordTypeWithStyle = True
 
    On Error GoTo errorHandler
 
    If IsMissing(sSignet) = True Then
 
    oWdDoc.Parent.Selection.EndKey Unit:=6, Extend:=0  'wdStory, wdMove
    oWdDoc.Parent.Selection.TypeParagraph
    oWdDoc.Parent.Selection.TypeText (sTexte)
    oWdDoc.Parent.Selection.Style = sStyle
 
    ElseIf IsMissing(sSignet) = False Then
    oWdDoc.Selection.Goto What:=wdGoToBookmark, Name:=sSignet
    oWdDoc.Parent.Selection.TypeText (sTexte)
    oWdDoc.Parent.Selection.Style = sStyle
 
    End If
Exit Function
 
errorHandler:
    bWordTypeWithStyle = False
 
End Function
 
Sub tt()
Dim t As Object
bWordCreate t, False, "C:\Users\K010354\Desktop\ttt.docx"
bWordTypeWithStyle t, "bjr", "Titre", "a"
End Sub

Je cherche aussi a utiliser un masque personalisé comme vous pourrez le voir et a ouvrir automatiquement la sauvegarde sur PPT, si vous sauriez comment faire

Merci !