[fr-users] Re: Retranscrire macro MS offoce word sous libreoffice writter

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 à users+help@fr.libreoffice.org 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