Discussion :

[Mobydick_62]

Bonjour,
En pièce jointe le fichier corrigé
Cordialement

Calendrier enquêteurs.ods

[kikssos]

Un énorme merci pour cette rapidité et celle belle macro !!!

[kikssos]

Bonjour,

J'aurais vraiment voulu cliquer sur le bouton Résolu mais malheureusement après plusieurs tests l'impression finit toujours par se décaler... cela provient peut-être de mon fichier et de la version de Libre office. Bref merci pour votre temps

Bonne journée

[Mobydick_62]

Bonjour,

Bah voilà que moi aussi, je rencontre le même problème. je vais regarder cela.
Cordialement

[kikssos]

ça me rassure un peu

[Mobydick_62]

Bonjour,

J'ai revu le code pour l'export. Ça fonctionne.

Cordialement

Calendrier enquêteurs.ods

[kikssos]

Toujours pas... la macro fonctionne que sur votre fichier et à condition je n'enlève pas la lecture seule. Au moment où je désactive la lecture seule tout se décale et lorsque je transpose la macro dans mon fichier le mail ne part plus et l'impression du pdf contient l'ensemble de mon classeur actif...

[Mobydick_62]

Bonsoir,

la macro fonctionne que sur votre fichier et à condition je n'enlève pas la lecture seule. Au moment où je désactive la lecture seule

J'ai remarqué quelquefois que le fait de simplement cliquer sur le bouton pour désactiver la lecture, entrainait des erreurs. En effet le fichier téléchargé se trouve dans un répertoire TEMP et j'ai vu sur des forums que cela pose problème.
Mieux vaut faire un enregistrer sous et enregistrer sur l'ordi en dehors du TEMP.

le mail ne part plus

C'est normal, comme je n'ai pas Out look j'ai mis dans le code ci-dessous un Exit Sub pour "zapper" cette partie. Et j'ai oublié de supprimer la ligne.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
  'Envoi Mail
  'Je change le format du chemin pour qu'il puisse être pris en compte par l'application Windows OUTLOOK
  sCheminDoc = ConvertFromURL(sCheminDoc)
 
 
Exit Sub 'A supprimer après essai
 
  oObj = createUnoService("com.sun.star.bridge.OleObjectFactory")  
  AppOutlook = oObj.createInstance("Outlook.Application")  
 
  oMail = AppOutlook.CreateItem(0)

je transpose la macro dans mon fichier le mail ne part plus et l'impression du pdf contient l'ensemble de mon classeur actif...

En effet en mettant d'autres feuilles, çà pose problème. Mais à la base tu m'as toujours fourni un classeur à une feuille.

Je vais voir çà, mais çà peut prendre du temps.
Cordialement

[kikssos]

Bonjour,
Juste un message pour venir aux nouvelles sur l'avancement de vos recherches concernant cette macro qui donne du sacré fil à retordre...
Merci d'avance

[kikssos]

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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
Sub Main
' Remplacer Feuille1 par le nom de feuille à exporter
ExportToPDF ("SIMULATION CONTRAT")
end sub
 
Sub ExportToPDF (sTableNam As String)
 
dim oDoc as object, oSheets as object, oSheet as object, oPlage as object, oEnCours as object, oRanges as object
dim lEndCol as long, lEndRow as long, lCoord(1) as long
dim nVar as integer
dim sPath as string,sStandard as string, sName
Dim Fichier as String
 
oDoc = ThisComponent
 
oSheets = oDoc.Sheets
 
' Vérifie que le classeur contient une feuille de ce nom
if oDoc.Sheets.hasByName(sTableNam) then
        oSheet = oDoc.Sheets.getByName(sTableNam) 
' Choix du dossier dans lequel exporter le pdf
        sPath = GetPath
' Vérifie si l'utilisateur a choisi un dossier
        If sPath = "" Then
                msgbox "Vous n'avez pas sélectionné de dossier", 64, "Export interrompu"      
        else
' Creation d'un nom par défaut incluant la date & heure pour le pdf        
                sStandard = "Simulation contrat " & osheet.getCellRangeByName("E2").String & " " &_
                osheet.getCellRangeByName("A2").String & " " & Format(Now,"ddmmyyyy") 
                sName = InputBox ("Donner un nom sans extension" & Chr(10) & _
                                "pour le PDF." , "Nom du PDF", sStandard )
' Si l'utilisateur n'a pas donné de nom
                If sName = "" Then
                        msgbox "Vous n'avez pas donné de nom pour le PDF", 64, "Export interrompu"
                        Stop
                else
' Si l'utilisateur a donné un nom ou gardé celui proposé par défaut    
                        sName = sName & ".pdf"
                        Fichier = spath + sname                                           
                        nVar = 0
' Vérifie que le fichier cible existe déjà ou non
' Si oui, possibilité d'écraser ou donner un autre nom                 
                        do while FileExists(sPath & sName) and nVar <> 2 and nVar <> 6
                                nVar = MsgBox ("Ce fichier existe déjà. " & Chr(10) & _
                                        "Voulez-vous le remplacer ? " & Chr(10) & _
                                        Chr(10) & _
                                        """Annuler"" pour arrêter l'export, " & Chr(10) & _
                                        """Non"" pour saisir un autre nom", 35, "Erreur")     
                                if nVar = 7 then
                                        sName = InputBox ("Donner un nom sans extension" & Chr(10) & _
                                                        "pour le PDF." , "Nom du PDF", sStandard )
                                        sName = sName & ".pdf"
                                end if
                        loop
 
                        if nVar <> 2 then
 
'                          oDoc.addActionLock
'                          oDoc.LockControllers
 
' Mémorise la sélection courante
                                oEnCours = oDoc.currentselection
 
' Vérifie si au moins une zone d'impression a été définie pour cette feuille
' Si oui on l'utilise, sinon on exporte toute la plage utilisée dans la feuille
                                if ubound(oSheet.PrintAreas) <> -1 then
' Création d'une instance "plage" vide qui permet de déselectionner
' (utile par ex. si l'utilisateur avait sélectionné un graphisme)                              
                                        oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
                                        oDoc.currentcontroller.activeSheet = oSheet
                                        oDoc.currentcontroller.select(oRanges)
                                else
                                        lCoord = GetLastUsed(oSheet)
                                        oPlage = oSheet.getCellRangeByPosition(0, 0, lCoord(0), lCoord(1))
                                        oDoc.currentcontroller.select(oPlage)
                                end if    
 
                                export_pdf(sPath & sName)  
 
' Restaure la sélection avant export
                                oDoc.currentcontroller.select(oEnCours)
 
                                MsgBox "Le PDF a été créé." , 64, "Export PDF"
 
'                          oDoc.UnlockControllers 
'                          oDoc.removeActionLock
 
                        end if
                end if
        End If 
else
 
    MsgBox "Nom de feuille incorrect", 16, "Erreur"
 
end if
 
 
Rem *** Initialisation des variables ***
 
     REM  %0D%0A =  retour à la ligne et saut de ligne
 
 
     Dim oShell As Object
     dim strMail as string
     Dim monDocument as Object, MesFeuilles as Object, MaFeuille as Object
     Dim litCellule as String, litSujet as String, litBody as String
     Dim Reponse as string
     dim pieces(0) as string
     MonDocument = ThisComponent
     MesFeuilles = MonDocument.sheets
     MaFeuille = MesFeuilles.GetByName("Saisie Simulation")
     litCellule= ThisComponent.Sheets.getByName("Saisie Simulation").getCellByPosition(2,14).getString
     litsujet = "Notre proposition pour " & MaFeuille.getCellRangeByName("A1").String
     litBody = "Bonjour," & "%0D%0A" & "%0D%0A" & "Nous vous proposons"
 
Rem *** Initialisation du mail ***
 
     Reponse = MsgBox ("Souhaitez-vous envoyer cette proposition par Email ?",132,"Envoi par Email") 
 
     	If Reponse = 6 then goto Suite
     	Stop
 
 
	Suite:
 
	on error resume next
	ochaos=createUnoService("com.sun.star.system.SimpleSystemMail")
	mail=ochaos.querySimpleMailClient()	
	lemessage=mail.createsimplemailmessage()
	lemessage.setrecipient(litCellule)
	lemessage.setsubject(litSujet)
	pieces(0)=Fichier
	lemessage.setAttachement(pieces())	
	mail.sendSimpleMailMessage(lemessage,0)	
 
 
	End Sub
 
'------------------------------------
Function GetLastUsed(oSheet as Object) 
Dim oCell as object, oCursor as object, oAddress as object
Dim lCoord(1) as long
        oCell = oSheet.getCellByPosition(0, 0)
        oCursor = oSheet.createCursorByRange(oCell)
        oCursor.gotoEndOfUsedArea(True)
        with oCursor.RangeAddress
                lCoord(0) = .EndColumn
                lCoord(1) = .EndRow
        end with  
        GetLastUsed = lCoord()
End Function
 
'----------------------------------
Function GetPath() As String
  Dim  oPathSettings, oFolderDialog
  Dim sPath As String
 
    oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
    sPath = "file:///d:/Temp/"
    oFolderDialog = _
          CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
    oFolderDialog.SetDisplayDirectory(sPath)
    If oFolderDialog.Execute() = _
          com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
      sPath = oFolderDialog.GetDirectory
    Else
      GetPath = ""
      Exit Function
    End If
  If Right(sPath, 1) <> "/" Then sPath = sPath & "/"
  GetPath = sPath
End Function  
 
'------------------------------------
sub export_pdf (sFileName AS String)
 
dim propFich(2) as new com.sun.star.beans.PropertyValue
dim filterProps(0) as new com.sun.star.beans.PropertyValue
 
filterProps(0).Name = "Selection"
filterProps(0).Value = thisComponent.currentSelection
 
propFich(0).Name = "FilterName"
propFich(0).Value = "calc_pdf_Export"
propFich(1).Name = "FilterData"
propFich(1).Value = filterProps()
 
 
ThisComponent.storeToURL(sFileName,propFich())
 
end sub

Bonjour, j'ai un souci avec le corps de mail je comprends pas pourquoi celui-ci reste à vide pourriez vous me dire là où est l'erreur merci d'avance

[Mobydick_62]

Bonsoir,
Pour ce que je sache "com.sun.star.system.SimpleSystemMail" ne permet pas les corps de texte.

Je te conseille vivement en fonction de ce que tu utilise OpenOffice ou Libre Office de consulter ce sujet sur un autre forum spécialisé :

https://forum.openoffice.org/fr/foru...p?f=15&t=39844

Personnellement je suis sous LibreOffice et j'utilise ce code: (code que j'ai trouvé et adapté sur le forum en question)

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
 '_______________________________________________________________________________________
 'Envoi du mail
 Sub EnvoiCourriel()
  Dim Produit As String, Prop As Boolean
  Dim oProdNameAccess as Object
  Dim sVersion As String, sProdName As String, NumVersion As String
  Dim sTexteMail As String 
 
  'Appel fonction
   sTexteMail = "Salut à tous." & chr(10) & "blablabla : "  & chr(10) & "Cordialement"
 
  GlobalScope.BasicLibraries.loadLibrary("Tools")
  oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
  sProdName = oProdNameAccess.getByName("ooName")
  sVersion = oProdNameAccess.getByName("ooSetupVersion")
  NumVersion = Left(sVersion,1)
'  On Error Goto Err_envoiMail 
  If GetGUIType = 1 Then ' 1 pour Windows
   If  Left(sProdName,4) = "Open" And NumVersion > 3 Then
	Call SMP 'version windows Aoo4
   Else	
	Call SSM 'Version Windows Aoo3/LibO3 & LibO4
    Prop = True
   End If
  Else '4 pour GNU_Linux
   If Left(sProdName,4) <> "Open" Or NumVersion < 4 Then 
   	Call SCM 'Version Linux Aoo3/LibO3 & LibO4
   	Prop = True
   Else
	Call SMP 'Version Linux Aoo4
   End If
  End If
 
  If IsNull(Client) Then
   MsgBox("Client de messagerie non disponible", 16)
   Stop
  End If
 
  Courrier.Subject = "SUJET DU MAIL"
  Courrier.Recipient = sDestinataires '(n'accepte pas les tableaux. Seulement une adresse ou plusieurs séparées par des point virgule)
'  Courrier.CcRecipient = Array("")'CopieA sous forme de tableau
'  Courrier.BccRecipient = sTabMail() 'Copie Caché sous forme de tableau
  Courrier.Attachement = sPieceJointe()
  Courrier.Body = sTexteMail
 
  Rem Controle du service !
  If Prop = True Then ' Si version Aoo3/LibO3 ou LibO4
   Client.sendsimpleMailMessage(Courrier,0)'1 pour envoi Auto - avec quel client de messagerie ??
  Else
   Client.sendMailMessage(Courrier,0)
  End If
 
  Exit_envoiMail:
  Exit Sub
  Err_envoiMail:
  msgbox Error
  Resume Exit_envoiMail	 
 End Sub      
 
 REM==================================
 Function SSM
  Messagerie = CreateUnoService("com.sun.star.system.SimpleSystemMail")'Version Windows Aoo3/LibO3
  Client = Messagerie.querySimpleMailClient()
  Courrier = Client.createSimpleMailMessage()
 End Function
 
 Function SCM
  Messagerie = CreateUnoService("com.sun.star.system.SimpleCommandMail")'Version Linux Aoo3/LibO3 & LibO4
  Client = Messagerie.querySimpleMailClient()
  Courrier = Client.createSimpleMailMessage()
 End Function
 
 Function SMP
  Messagerie = CreateUnoService("com.sun.star.system.SystemMailProvider")'Version Windows/Linux Aoo4
  Client = Messagerie.queryMailClient()
  Courrier = Client.createMailMessage()
 End Function