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
| Sub Main
'crée une boite de dialogue pour demander la date
'Attention, la boite de dialogue est aussi à créer en cliquant droit dans l'onglet en bas de l'éditeur de macro sur "module", puis "Insérer" et "Boite de dialogue BASIC".
'il faut ensuite ajouter les éléments suivant (bouton * 2, 1 champ date)
'Dans le bouton "OK", il faut aller dans propriété et aller à la ligne "Type de bouton" pour sélectionner "OK". Si vous ne le faite pas, le bouton sera inerte.
'Dans le bouton "Annuler", il faut aller dans propriété et aller à la ligne "Type de bouton" pour sélectionner "Annuler". Si vous ne le faite pas, le bouton sera inerte.
'Dans le champ date, il faut aller dans propriété et aller à la ligne "Vérification du format" et "Sélectionner "OUI". Dans la ligne "Format date", mettre ce que vous voullez.
Dim Dlg As Object, bibli As Object, monDialogue As Object, InputDate as string, Car as string
BasicLibraries.LoadLibrary("Standard") 'Chargement des bibliothèques
DialogLibraries.LoadLibrary("Standard")
bibli = DialogLibraries.GetByName("Standard")
monDialogue = bibli.GetByName("Dialog1") 'Accès au dialogue
Dlg = CreateUnoDialog(monDialogue) 'Exécution du dialogue
' -- Bouton OK
Dlg.getControl("CommandButton1").Label ="OK"
Dlg.getControl("CommandButton1").Model.Align = 1
' -- Bouton Annuler
Dlg.getControl("CommandButton2").Label ="Annuler"
Dlg.getControl("CommandButton2").Model.Align = 1
' -- Boite
Dlg.setTitle("Date ?")
'Lance l'exécution de la boite de dialogue
Dlg.execute
InputDate = format(Dlg.getControl("DateField1").text, "d MMMM yyyy") 'Récupère la date saisie et le met au format désiré
Car = Mid(InputDate, 1, 2)
if Car = "1 " then
Car = ""
Mid(InputDate, 1, 2) = Car
Car = "1er "
InputDate = Car & InputDate
end if
Write_Cursor_Position (InputDate)
End Sub
'--------------------------
' La procedure "Write_Cursor_Position" est inspiree de from: http://www.oooforum.org/forum/viewtopic.phtml?t=75409
' Coller du texte dans Writer a la position du curseur
Sub Write_Cursor_Position (sText as String)
Dim oViewCursor as object
dim oText As Object
oViewCursor= thiscomponent.GetCurrentController.ViewCursor
If IsEmpty(oViewCursor.Cell) Then
oText=thiscomponent.text
Else
oText=oViewCursor.Cell.Text
End If
oText.insertString(oViewCursor, sText,false)
end Sub |
Partager