[VB6/VBA] The CommonDialog control

The available functions with CommonDialog

• The dialog box> Open File
• The dialog box> Save as
• The dialog box> Print
• The dialog box> Selecting a policy

Getting started

An example of a standard module

Option Explicit

Public Filter1 As String
Public Filter2 As String
Public Filter 3 As String
Public Filter 4 As String
Public Filter 5 As String
Public Filter As String
Public Filter 7 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 add(a$) As String
    If a$ <> "" Then a$ = a$ + "|"
    add = a$
End Function

'Command lines ...
'FileName = cmd_open()
'If 1 filter more >> FileName = cmd_open("txt") 
'If multiple filters, initialize filter1 to 4 
'routine adds all the filter
Function cmd_open(Optional Filt1 As String) As String
Dim CTRL$, a$, b$, F1$, F2$, F3$, F4$
CTRL$ = Chr$(13) + Chr$(10)
    If Filt1 <> "" Then
        a$ = " File (*." & Filt1 & ") | *." & Filt1
    End If
    If Filter1 <> "" Then
        a$ = add(a$)
        a$ = a$ + " File (*." & Filter1 & ") | *." & Filter1
        Filter1 = ""
    End If
    If Filter2 <> "" Then
        a$ = add(a$)
        a$ = a$ + " File (*." & Filter2 & ") | *." & Filter2
        Filter2 = ""
    End If
    If Filter3 <> "" Then
        a$ = add(a$)
        a$ = a$ + " File (*." & Filter3 & ") | *." & Filter3
        Filter 3 = ""
    End If
    If Filter4 <> "" Then
        a$ = add(a$)
        a$ = a$ + " File (*." & Filter4 & ") | *." & Filter4
        Filter4 = ""
    End If
        a$ = add(a$)
        a$ = a$ + " All (*.*) | *.*"
    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_open = Dialog.CMDialog1.FileName
    Unload Dialog
End Function

Function cmd_Policy()
    Dialog.CMDialog1.DialogTitle = "Select policy"
    Dialog.CMDialog1.FLAGS = CF_WYSIWYG + CF_BOTH + CF_SCALABLEONLY
    Dialog.CMDialog1.Action = DLG_FONT
    Filter1 = Dialog.CMDialog1.FontName
    Filter4 = Dialog.CMDialog1.FontSize
    Filter5 = Dialog.CMDialog1.FontBold
    Filter6 = Dialog.CMDialog1.FontItalic
    cmd_Policy = 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 = file extension to be searched for
'eg: TXT ou EXE
'routine adds all the filter(*.*)
Function cmd_SaveAs(Filt1 As String) As String
    Filter1 = "File (*." & Filt1 & ") | *." & Filt1
    Filter2 = "All (*.*) | *.*"
    Dialog.CMDialog1.Filter = Filter1 + "|" + Filter2
    Dialog.CMDialog1.FilterIndex = 1
    Dialog.CMDialog1.FLAGS = OFN_HIDEREADONLY
    Dialog.CMDialog1.Action = DLG_FILE_SAVE
    cmd_SaveAs = Dialog.CMDialog1.FileName
    Unload Dialog

End Function