Tout d'abord merci d'avoir pris le temps de jeter un coup d'oeil,
je te fais part du code de ma macro sous word.
Je met tout le code, on ne sait jamais.
"
Attribute VB_Name = "Export_Certif"
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As
String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Sub Export_Certif()
'
' test Macro
Dim retourINI
Dim apporteur
Dim test As Boolean
Dim document1, f
Dim directory
Dim rep, fichier
Dim savefile
Dim fs, fs1, prnt
'on recherche sur quel apporteur on travaille
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Votre conseiller ADEP:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
apporteur = Selection
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
If (LireINI("blocage", "bloc")) <> 1 Then
retourINI = EcrireINI("blocage", "bloc", "1")
ChangeFileOpenDirectory ("R:\SANTE\")
directory = "R:\SANTE\"
fichier = apporteur + "_" + Right(Date, 4) + Mid(Date, 4, 2) +
Left(Date, 2) + ".doc"
savefile = directory + fichier
' ActiveDocument.ExportAsFixedFormat OutputFileName:= _
savefile, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint,
Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent,
_
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True,
BitmapMissingFonts:= _
True, UseISO19005_1:=False
prnt = ActivePrinter
ActivePrinter = "PDF-XChange for ABBYY PDF Transformer 2.0"
' Permet l'enregistrement dans Premuni
ActiveDocument.Save
'Demander le nombre d'impression
Dim Message, Title, Default, nbcopie
' Définit le message.
Message = "Entrez le nombre d'impression ? ( Exemple : 1 )"
Title = "Nb de Copie" ' Définit le titre.
Default = "1" ' Définition la valeur par défaut.
' Affiche le message, le titre et la valeur par défaut.
nbcopie = InputBox(Message, Title, Default)
' Permet l'enregistrement pour sauvegarde PDR
ActiveDocument.SaveAs FileName:=savefile _
, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True,
WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False,
SaveAsAOCELetter:= _
False
Application.PrintOut Background:=False, FileName:="", _
Range:=wdPrintAllDocument, Item:=wdPrintDocumentContent, _
Copies:=nbcopie, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, PrintToFile:=True, _
OutputFileName:=savefile, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
ActivePrinter = prnt
ActiveDocument.Close SaveChanges:=False
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile savefile
'If fichier <> "" Then
' Selection.WholeStory
' Selection.Copy
' Documents.Open FileName:=fichier, ConfirmConversions:=False, _
' ReadOnly:=False, AddToRecentFiles:=True, PasswordDocument:="", _
' PasswordTemplate:="", Revert:=False, WritePasswordDocument:="",
_
' WritePasswordTemplate:="", Format:=wdOpenFormatAuto
' Selection.EndKey Unit:=wdStory
' Selection.InsertBreak Type:=wdPageBreak
' Selection.PasteAndFormat (wdPasteDefault)
'ActiveDocument.ActiveWindow.Close SaveChanges:=wdSaveChanges
' Else
' ActiveDocument.SaveAs FileName:=apporteur + "_" + Right(Date, 4) +
Mid(Date, 4, 2) + Left(Date, 2) + _
' ".doc", FileFormat:=wdFormatDocument, _
' LockComments:=False, Password:="", AddToRecentFiles:=True,
WritePassword _
' :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
' SaveNativePictureFormat:=False, SaveFormsData:=False,
SaveAsAOCELetter:= _
' False
' End If
' ActiveDocument.ActiveWindow.Close SaveChanges:=wdSaveChanges
retourINI = EcrireINI("blocage", "bloc", "0")
Application.Quit
Else
MsgBox ("Le blocage est actif, veuillez recommencer l'opération
ultérieurement")
End If
End Sub
Function LireINI(Entete As String, Variable As String) As String
Dim Retour As String
'fichier = App.Path & "\" & App.EXEName & ".ini"
fichier = "R:\SANTE\certif\" + "blocage.ini"
Retour = String(255, Chr(0))
LireINI = Left$(Retour, GetPrivateProfileString(Entete, ByVal Variable,
"", Retour, Len(Retour), fichier))
End Function
Function EcrireINI(Entete As String, Variable As String, Valeur As String)
As String
fichier = "R:\SANTE\certif\" + "blocage.ini"
'fichier = App.Path & "\" & App.EXEName & ".ini"
WriteINI = WritePrivateProfileString(Entete, Variable, Valeur, fichier)
End Function
"
Voilà ce que faisait ma macro.
Pour répondre à une de tes questions le code entre [[]] me remonter l'info
qui est stocké dans la base de donnée.
Cordialement
--
View this message in context:
http://nabble.documentfoundation.org/Retranscrire-macro-MS-offoce-word-sous-libreoffice-writter-tp3634567p3647623.html
Sent from the Users mailing list archive at Nabble.com.
--
Envoyez un mail à [email protected] pour savoir comment vous
désinscrire
Les archives de la liste sont disponibles à
http://listarchives.libreoffice.org/fr/users/
Tous les messages envoyés sur cette liste seront archivés publiquement et ne
pourront pas être supprimés
