VB6/VBA - Le contrôle CommonDialog.
Les différentes fonctions du contrôle CommonDialog
J'ai laissé toutes les constantes disponibles bien qu'elles ne sont pas toutes utilisées dans les fonctions proposées, elles permettront d'éventuelles recherches sur d'autres données possibles.
Les fonctions possibles avec Commond Dialog
- La boîte de dialogue > Ouvrir un fichier
- La boîte de dialogue > Sauve sous
- La boîte de dialogue > Imprimer
- La boîte de dialogue > Sélection d'une police
Préliminaires
Une form > Name = Dialog
Un contrôle CommonDialog > Name = CMDialog1
bouton1 > Caption = Ouvrir Fichier
Code dans CommandX_Click() > Ret = cmd_Ouvre() >voir les rem pour plus de détails.
bouton2 > Caption = Sauve sous
Code dans Clic Ret = cmd_Ouvre()
bouton3 > Caption = Imprimer
Code dans CommandX_Click() > Ret = cmd_Print()
bouton4 > Caption = Police
Code dans CommandX_Click() > Ret = cmd_Police()
Dans un module standard
Option Explicit
Public Filtre1 As String
Public Filtre2 As String
Public Filtre3 As String
Public Filtre4 As String
Public Filtre5 As String
Public Filtre6 As String
Public Filtre7 As String
Public Const DLG_FILE_OPEN = 1
Public Const DLG_FILE_SAVE = 2
Public Const DLG_COLOR = 3
Public Const DLG_FONT = 4
Public Const DLG_Print = 5
Public Const DLG_HELP = 6
'File Open/Save Dialog Flags
Public Const OFN_READONLY = &H1&
Public Const OFN_OVERWRITEPROMPT = &H2&
Public Const OFN_HIDEREADONLY = &H4&
Public Const OFN_NOCHANGEDIR = &H8&
Public Const OFN_SHOWHELP = &H10&
Public Const OFN_NOVALIDATE = &H100&
Public Const OFN_ALLOWMULTISELECT = &H200&
Public Const OFN_EXTENSIONDIFFERENT = &H400&
Public Const OFN_PATHMUSTEXIST = &H800&
Public Const OFN_FILEMUSTEXIST = &H1000&
Public Const OFN_CREATEPROMPT = &H2000&
Public Const OFN_SHAREAWARE = &H4000&
Public Const OFN_NOREADONLYRETURN = &H8000&
'Color Dialog Flags
Public Const CC_RGBINIT = &H1&
Public Const CC_FULLOPEN = &H2&
Public Const CC_PREVENTFULLOPEN = &H4&
Public Const CC_SHOWHELP = &H8&
'Fonts Dialog Flags
Public Const CF_SCREENFONTS = &H1&
Public Const CF_PRINTERFONTS = &H2&
Public Const CF_BOTH = &H3&
Public Const CF_SHOWHELP = &H4&
Public Const CF_INITTOLOGFONTSTRUCT = &H40&
Public Const CF_USESTYLE = &H80&
Public Const CF_EFFECTS = &H100&
Public Const CF_APPLY = &H200&
Public Const CF_ANSIONLY = &H400&
Public Const CF_NOVECTORFONTS = &H800&
Public Const CF_NOSIMULATIONS = &H1000&
Public Const CF_LIMITSIZE = &H2000&
Public Const CF_FIXEDPITCHONLY = &H4000&
Public Const CF_WYSIWYG = &H8000& 'must also have CF_SCREENFONTS & CF_PRINTERFONTS
Public Const CF_FORCEFONTEXIST = &H10000
Public Const CF_SCALABLEONLY = &H20000
Public Const CF_TTONLY = &H40000
Public Const CF_NOFACESEL = &H80000
Public Const CF_NOSTYLESEL = &H100000
Public Const CF_NOSIZESEL = &H200000
'Printer Dialog Flags
Public Const PD_ALLPAGES = &H0&
Public Const PD_SELECTION = &H1&
Public Const PD_PAGENUMS = &H2&
Public Const PD_NOSELECTION = &H4&
Public Const PD_NOPAGENUMS = &H8&
Public Const PD_COLLATE = &H10&
Public Const PD_PRINTTOFILE = &H20&
Public Const PD_PRINTSETUP = &H40&
Public Const PD_NOWARNING = &H80&
Public Const PD_RETURNDC = &H100&
Public Const PD_RETURNIC = &H200&
Public Const PD_RETURNDEFAULT = &H400&
Public Const PD_SHOWHELP = &H800&
Public Const PD_USEDEVMODECOPIES = &H40000
Public Const PD_DISABLEPRINTTOFILE = &H80000
Public Const PD_HIDEPRINTTOFILE = &H100000
'Help Constants
Public Const HELP_CONTEXT = &H1 'Display topic in ulTopic
Public Const HELP_QUIT = &H2 'Terminate help
Public Const HELP_INDEX = &H3 'Display index
Public Const HELP_CONTENTS = &H3
Public Const HELP_HELPONHELP = &H4 'Display help on using help
Public Const HELP_SETINDEX = &H5 'Set the current Index for multi index help
Public Const HELP_SETCONTENTS = &H5
Public Const HELP_CONTEXTPOPUP = &H8
Public Const HELP_FORCEFILE = &H9
Public Const HELP_KEY = &H101 'Display topic for keyword in offabData
Public Const HELP_COMMAND = &H102
Public Const HELP_PARTIALKEY = &H105 'call the search engine in winhelp
Function ajoute(a$) As String
If a$ <> "" Then a$ = a$ + "|"
ajoute = a$
End Function
'Lignes d'appel...
'NomFichier = cmd_ouvre()
'Si 1 filtre en plus >> NomFichier = cmd_ouvre("txt") < par ex.
'Si plusieurs filtres, initialiser les filtres Filtre1 à 4
'la routine ajoute le filtre tous (*.*)
Function cmd_Ouvre(Optional Filt1 As String) As String
Dim CTRL$, a$, b$, F1$, F2$, F3$, F4$
CTRL$ = Chr$(13) + Chr$(10)
If Filt1 <> "" Then
a$ = " Fichier (*." & Filt1 & ") | *." & Filt1
End If
If Filtre1 <> "" Then
a$ = ajoute(a$)
a$ = a$ + " Fichier (*." & Filtre1 & ") | *." & Filtre1
Filtre1 = ""
End If
If Filtre2 <> "" Then
a$ = ajoute(a$)
a$ = a$ + " Fichier (*." & Filtre2 & ") | *." & Filtre2
Filtre2 = ""
End If
If Filtre3 <> "" Then
a$ = ajoute(a$)
a$ = a$ + " Fichier (*." & Filtre3 & ") | *." & Filtre3
Filtre3 = ""
End If
If Filtre4 <> "" Then
a$ = ajoute(a$)
a$ = a$ + " Fichier (*." & Filtre4 & ") | *." & Filtre4
Filtre4 = ""
End If
a$ = ajoute(a$)
a$ = a$ + " Tous (*.*) | *.*"
Dialog.CMDialog1.Filter = a$
Dialog.CMDialog1.FilterIndex = 1
Dialog.CMDialog1.FLAGS = CF_EFFECTS Or OFN_HIDEREADONLY Or CF_ANSIONLY
Dialog.CMDialog1.Action = DLG_FILE_OPEN
cmd_Ouvre = Dialog.CMDialog1.FileName
Unload Dialog
End Function
Function cmd_Police()
Dialog.CMDialog1.DialogTitle = "Sélection police"
Dialog.CMDialog1.FLAGS = CF_WYSIWYG + CF_BOTH + CF_SCALABLEONLY
Dialog.CMDialog1.Action = DLG_FONT
Filtre1 = Dialog.CMDialog1.FontName
Filtre4 = Dialog.CMDialog1.FontSize
Filtre5 = Dialog.CMDialog1.FontBold
Filtre6 = Dialog.CMDialog1.FontItalic
cmd_Police = Dialog.CMDialog1.FontName
End Function
Function cmd_Print()
Dialog.CMDialog1.FLAGS = PD_ALLPAGES
Dialog.CMDialog1.Min = 1
Dialog.CMDialog1.Max = 100
Dialog.CMDialog1.FromPage = 1
Dialog.CMDialog1.ToPage = 100
Dialog.CMDialog1.Action = DLG_Print
Unload Dialog
End Function
'Filt1 = extention des fichiers à chercher
'ex: TXT ou EXE
'la routine ajoute le filtre tous (*.*)
Function cmd_SaveAs(Filt1 As String) As String
Filtre1 = "Fichier (*." & Filt1 & ") | *." & Filt1
Filtre2 = "Tous (*.*) | *.*"
Dialog.CMDialog1.Filter = Filtre1 + "|" + Filtre2
Dialog.CMDialog1.FilterIndex = 1
Dialog.CMDialog1.FLAGS = OFN_HIDEREADONLY
Dialog.CMDialog1.Action = DLG_FILE_SAVE
cmd_SaveAs = Dialog.CMDialog1.FileName
Unload Dialog
End Function
