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