Sub ChoixFichier()
    'La variable est de type Variant car elle peut prendre les valeurs :
        'Booleenne: (Vrai/Faux) quand l'utilisateur ne sélectionne rien, ou annule l'opération.
        'String: pour renvoyer le nom du fichier sélectionné.
    Dim Fichier As Variant
 
    'Affiche la boîte de dialogue "Ouvrir"
    Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
 
    'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur
    'a cliqué sur le bouton "Annuler", ou sur la croix de fermeture.
    If Fichier = False Then Exit Sub
 
    'Affiche le chemin et le nom du fichier sélectionné.
    MsgBox Fichier
 
End Sub

    Fichier = Application.GetOpenFilename _
        ("Fichiers Images (*.jpg), *.jpg" & _
        ",Fichiers Images (*.gif), *.gif")

    Fichier = Application.GetOpenFilename _
        ("Fichiers Images (*.jpg; *.gif),*.jpg;*.gif")

Sub ChoixMultiFichiers()
    Dim Fichiers As Variant
    Dim i As Integer
 
    'Affiche la boîte dialogue "Ouvrir" en filtrant sur les classeurs Excel
    '(C'est l'argument True qui autorise la multi-sélection)
    Fichiers = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls", , , , True)
 
    'Boucle sur le tableau pour récupérer le nom du ou des classeurs sélectionnées.
    '(IsArray(Fichiers) renvoie False si aucun fichier n'a été sélectionné).
    If IsArray(Fichiers) Then
        For i = 1 To UBound(Fichiers)
            MsgBox Fichiers(i)
        Next
    End If
End Sub

Sub ChoixRepertoire()
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    MsgBox Chemin
End Sub

Sub Utilisation_FileDialog_SelectionFichier()
    Dim x As Long
 
    With Application.FileDialog(msoFileDialogFilePicker)
        'Définit un titre pour la boîte de dialogue
        .Title = "Le tite de la fenêtre:"
        'Autorise la multi-sélection
        .AllowMultiSelect = True
 
        'Définit un nom de fichier par défaut
        '.InitialFileName = "Nom document.doc"
 
        'Efface les filtres existants.
        .Filters.Clear
        'Définit une liste de filtres pour le champ "Type de fichiers".
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
        'La valeur 1 permet de spécifier que ce filtre est positionner en premier dans la liste de choix.
        .Filters.Add "Documents Word", "*.doc; *.docx; *.docm", 1
        'Définit le filtre qui s'affiche par défaut dans le champ "Type de fichiers".
        .FilterIndex = 2
 
        'Indique le type d'affichage dans la boîte de dialogue (exemple visualisation des propriétés)
        .InitialView = msoFileDialogViewProperties
        'Affiche la boîte de dialogue
        .Show
 
        'Boucle sur les fichiers sélectionnés
        For x = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(x)
        Next x
 
    End With
 
End Sub

Sub Utilisation_FileDialog_SelectionDossier()
    Dim x As Long
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Définit un titre pour la boîte de dialogue
        .Title = "Le tite de la fenêtre:"
        'Affiche la boîte de dialogue
        .Show
 
        'Affiche le nom du dossier sélectionné
        If .SelectedItems.Count > 0 Then
            MsgBox .SelectedItems(1)
        End If
 
    End With
End Sub

Sub Utilisation_FileDialog_Sauvegarde()
    Dim objSaveBox As FileDialog
 
    'Définit la fenêtre "Enregistrer sous"
    Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
    With objSaveBox
        'Définit un nom par défaut dans le champ "Nom de fichier".
        .InitialFileName = "Nom fichier.xls"
 
        'Définit le type de fichier par défaut :
        '(la valeur 4 Permet de spécifier les classeurs "Excel 97-2003" lorsque vous êtes dans Excel 2007)
        .FilterIndex = 4
 
        'Affiche la boîte de dialogue
        .Show
        'Enregistre
        .Execute
    End With
 
End Sub

Sub Utilisation_FileDialog_Ouvrir()
    Dim objOuvrir As FileDialog
    Dim objFichiers As FileDialogSelectedItems
    Dim x As Long
    Dim Wb As Workbook
 
    'Affiche la fenêtre "Ouvrir"
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ""
        'Efface les filtres existants.
        .Filters.Clear
        'Définit une liste de filtres pour le champ "Type de fichiers".
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
        'Indique le type d'affichage dans la boîte de dialogue
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
 
    'Définit le ou les fichiers à ouvrir
    Set objFichiers = Application.FileDialog(msoFileDialogOpen).SelectedItems
 
    'On sort si aucun fichier n'a été sélectionné
    If objFichiers.Count = 0 Then Exit Sub
 
 
    Application.ScreenUpdating = False
 
    'Boucle sur le ou les fichiers Excel sélectionnés pour les ouvrir
    For x = 1 To objFichiers.Count
        Set Wb = Workbooks.Open(objFichiers(x))
        '
        'traitement
        '
        'Referme le classeur sans enregistrer les modifications.
        Wb.Close False
    Next
 
    Application.ScreenUpdating = True
 
End Sub

NomFichier = Application.GetOpenFilename("Classeurs Excel(*.xls),*.xls, Macros complémentaires (*.xla),*.xla")

MsgBox "Bonjour!"

MsgBox "Bonjour!", vbExclamation

Dim Reponse As Long
 
Reponse = MsgBox("Voulez vous continuer ?", vbQuestion + vbYesNo)
If Reponse = vbYes Then
    MsgBox "On continue ...", vbExclamation
    Else
    MsgBox "Au revoir ...", vbInformation
End If

MsgBox "Bonjour " & Environ("username"), vbInformation, "Accueil"

Dim Msg As String
Dim Cellule As Range
 
On Error Resume Next
'Va provoquer une erreur 'définie par l'application ou par l'objet' car
'Cells(0, 1) ne peut pas exister.
Set Cellule = Cells(0, 1)
 
'MsgBox Err.HelpContext
 
Msg = "Cliquez sur le bouton AIDE pour consulter la rubrique relative à cette erreur."
MsgBox Msg, vbMsgBoxHelpButton, "Erreur", Err.HelpFile, Err.HelpContext

MsgBox "Bonjour " & Environ("username") & _
            vbCrLf & vbCrLf & _
            "Nous sommes le " & Date, _
            vbCritical, "Accueil"

Dim Reponse As Long
Dim cstMsgBox As VbMsgBoxStyle
 
cstMsgBox = vbYesNo + vbDefaultButton2
Reponse = MsgBox("Bonjour", cstMsgBox)
 
If Reponse = vbYes Then MsgBox "Oui"

'---------------------------------------------------------------------------------------
' Module      : modIconeDansMsgBox
' Auteur      : fred65200 - Frédéric CHAPIN -
'https://www.developpez.net/forums/private.php?do=newpm&u=190475
' Date        : 06/02/2009
' Description : Placer une icône perso dans la barre de titre d'un MsgBox
'               Plus lourd qu'un UserForm, intéressant pour l'utilisation des APIs
'---------------------------------------------------------------------------------------
 
Option Explicit
 
'Constantes des MsgBox Windows
Private Const MB_OK = 0
Private Const MB_OKCANCEL = 1
Private Const MB_ABORTRETRYIGNORE = 2
Private Const MB_YESNOCANCEL = 3
Private Const MB_YESNO = 4
Private Const MB_RETRYCANCEL = 5
 
Private Const MB_ICONHAND = 16
Private Const MB_ICONQUESTION = 32
Private Const MB_ICONEXCLAMATION = 48
Private Const MB_ICONASTERISK = 64
 
Private Const MB_ICONINFORMATION = 64
Private Const MB_ICONSTOP = 16
 
Private Const MB_DEFBUTTON1 = 0
Private Const MB_DEFBUTTON2 = 256
Private Const MB_DEFBUTTON3 = 512
 
Private Const MB_APPLMODAL = 0
Private Const MB_SYSTEMMODAL = 4096
Private Const MB_TASKMODAL = 8192
 
'Valeurs renvoyées par les MsgBox Windows
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
 
Private Const IDPROMPT = &HFFFF&
 
Private Const HWND_DESKTOP = 0
 
Private X As Long
 
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
 
Private Type MSGBOX_HOOK_PARAMS
   hwndOwner   As Long
   hHook       As Long
End Type
 
Private MHP As MSGBOX_HOOK_PARAMS
 
Private Declare Function ExtractIconA Lib "shell32.dll" ( _
    ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
Private Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" ( _
   ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
 
Private Declare Function MessageBox Lib "user32" _
   Alias "MessageBoxA" ( _
   ByVal hwnd As Long, _
   ByVal lpText As String, _
   ByVal lpCaption As String, _
   ByVal wType As Long) As Long
 
Public Declare Function SendMessageA Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
 
Private Declare Function SetDlgItemText Lib "user32" _
   Alias "SetDlgItemTextA" ( _
   ByVal hDlg As Long, _
   ByVal nIDDlgItem As Long, _
   ByVal lpString As String) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" _
   Alias "SetWindowsHookExA" ( _
   ByVal idHook As Long, _
   ByVal lpfn As Long, _
   ByVal hmod As Long, _
   ByVal dwThreadId As Long) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
    ByVal hHook As Long) As Long
 
 
Sub Test()
monMsgBox MB_OK, "monTitre", "Bla bla"
monMsgBox MB_YESNO + MB_ICONQUESTION, "monTitre", "Bla bla"
monMsgBox MB_OKCANCEL + MB_ICONEXCLAMATION, "monTitre", "Bla bla"
monMsgBox MB_OKCANCEL + MB_ICONHAND, "monTitre", "Bla bla"
monMsgBox MB_ABORTRETRYIGNORE + MB_ICONASTERISK + MB_DEFBUTTON2, "monTitre", "Bouton 2 par défaut"
 
End Sub
 
Function monMsgBox( _
    boutons As Long, _
    titre As String, _
    texte As String) As Long
 
  'Interception du Hook
   With MHP
      .hwndOwner = HWND_DESKTOP
      .hHook = SetWindowsHookEx(WH_CBT, _
                                AddressOf MsgBoxHookProc, _
                                GetWindowLong(HWND_DESKTOP, GWL_HINSTANCE), _
                                GetCurrentThreadId())
   End With
 
  'Appel de la fonction API
   monMsgBox = MessageBox(HWND_DESKTOP, _
                            texte, _
                            titre, _
                            boutons)
 
 
End Function
 
Function MsgBoxHookProc( _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
 
'Le MsgBox va bientôt s'afficher
If uMsg = HCBT_ACTIVATE Then
 
    'Bouton Ok personnalisé
    SetDlgItemText wParam, IDOK, "C'est b&on"
    SetDlgItemText wParam, IDCANCEL, "&Annule moi ça"
    SetDlgItemText wParam, IDYES, "&Ouuuui!"
    SetDlgItemText wParam, IDNO, "&Nooooon!"
 
    'icône Word pour le sujet
    X = ExtractIconA(0, Application.Path & Application.PathSeparator & "Winword.exe", 0)
    SendMessageA wParam, &H80, False, X
 
    '«Unhook»
    UnhookWindowsHookEx MHP.hHook
 
End If
 
MsgBoxHookProc = False
 
End Function

Sub Test_V01()
    Dim Valeur As String
 
    Valeur = InputBox("Saisissez votre prénom:", _
        "Le titre", "Donnée par défaut.", 100, 400)
 
    MsgBox Valeur
End Sub

Sub Test_V02()
    Dim Plage As Range
 
    set Plage = Application.InputBox("Sélectionnez une plage de cellule", _
        "Le titre", , , , "C:\dossier\FichierAide.hlp", 100, Type:=8)
 
    MsgBox Plage.Address
End Sub

Sub Test_V03()
    Dim Valeur As Single
 
    'Type:=1 définit un type de donnée numérique
    Valeur = Application.InputBox("Saisissez une valeur", Type:=1)
    If Valeur = 0 Then Exit Sub
 
    'On multiplie la saisie par 5
    MsgBox Valeur * 5
End Sub

Sub Test_V04()
    Dim Donnee As Variant
 
    Donnee = Application.InputBox("Saisissez une valeur:", "Le titre")
 
   'Intercepte l'utilisation du bouton "Annuler" et la croix de fermeture.
   If VarType(Donnee) = vbBoolean Then
        MsgBox " opération annulée"
        Exit Sub
    End If
 
    MsgBox Donnee
End Sub

Dim Source As Range
 
Set Source = Application.InputBox("Sélectionnez une plage de cellules : ", , , , , , , 8)
MsgBox Source.Address

CreateObject("Wscript.shell").Popup "Mon Texte", 3, "Le Titre"

Sub UtilisezCompagnon_Personnalise()
    Dim i As Byte
 
    With Assistant.NewBalloon
        .Animation = msoAnimationEmptyTrash
        .Button = msoButtonSetOK
        .Heading = "Consultez les ressources DVP."
        .Text = "Sélectionnez un élément puis cliquez sur le bouton 'OK'."
 
         .CheckBoxes(1).Text = "Les sources Excel"
         .CheckBoxes(2).Text = "Le forum Excel"
         .CheckBoxes(3).Text = "La FAQ VBA"
         .CheckBoxes(4).Text = "Les cours VBA"
 
        .Icon = msoIconTip
        .Show
 
        For i = 1 To 4
            If .CheckBoxes(i).Checked = True Then
                Select Case i
                    Case 1
                    ThisWorkbook.FollowHyperlink "https://excel.developpez.com/sources/"
                    Case 2
                    ThisWorkbook.FollowHyperlink "https://www.developpez.net/forums/f542/logiciels/microsoft-office/excel/"
                    Case 3
                    ThisWorkbook.FollowHyperlink "https://vb.developpez.com/faqvba/"
                    Case 4
                    ThisWorkbook.FollowHyperlink "https://vb.developpez.com/cours/"
                End Select
 
                Exit For
            End If
        Next
    End With
 
    Assistant.Visible = False
 
End Sub

Sub Utiliser_MSagent()
    Dim Chemin As String
    Dim ArrayAttitude As Variant
    Dim j As Integer
    Dim Ag As AgentObjects.Agent
    Dim Personnage As AgentObjects.IAgentCtlCharacter
 
    'Liste des attitudes
    ArrayAttitude = Array("Alert", "Announce", "Blink", "Confused", "Congratulate", "Congratulate_2", _
        "Decline", "DoMagic2", "DontRecognize", "Explain", "GestureDown", "GestureLeft", "GetAttention", _
        "GetAttentionReturn", "Greet", "Idle1_1", "Idle1_2", "LookDown", "LookDownBlink", _
        "LookDownReturn", "LookUp", "MoveDown", "Pleased", "Process", "Read", "ReadContinued", _
        "ReadReturn", "RestPose", "Search", "StartListening", "StopListening", "Suggest", "Surprised", _
        "Wave", "Write", "WriteContinued", "WriteReturn")
 
    'Définit le fichier du personnage
    Chemin = Environ("windir") & "\msagent\chars\merlin.acs"
 
    Set Ag = New AgentObjects.Agent
    Ag.Connected = True
    Ag.Characters.Load "Merlin", Chemin
        '&h409 anglais
        '&H40C français
    Ag.Characters("Merlin").LanguageID = &H409
 
    Set Personnage = Ag.Characters("Merlin")
 
    With Personnage
        'Affichage
        .Show
        'Définit la largeur du personnage
        .Width = 200
        'Définit la hauteur
        .Height = 200
        'Position à l'écran
        .MoveTo 400, 300
    End With
 
 
    On Error Resume Next
    For j = 0 To UBound(ArrayAttitude)
 
        'Texte
        Personnage.Speak ArrayAttitude(j)
        'Attitude
        Personnage.Play ArrayAttitude(j)
 
        'Pause: 3 secondes
        Application.Wait (TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 3))
    Next j
    On Error GoTo 0
 
    Personnage.Speak "\Chr=""Whisper""\Au revoir! " & Environ("username")
    'Pause: 3 secondes
    Application.Wait (TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 3))
 
    Set Personnage = Nothing
    Set Ag = Nothing
End Sub

Application.Dialogs.Item(xlDialogSaveAs).Show

'Application.Dialogs.Item(xlDialogSaveAs).Show document_text, type_num, prot_pwd, backup, 
   'write_res_pwd, read_only_rec
Application.Dialogs.Item(xlDialogSaveAs).Show "NomClasseur.xls", , "PassWord"

'Paramètre par macro les arguments de la boite de dialogue xlDialogCopyPicture
'1= 1ere option de chaque argument
'2= 2eme option de chaque argument
Application.Dialogs.Item(xlDialogCopyPicture).Show 1, 2

'Enregistrer sous
CommandBars.FindControl(ID:=748).Execute

Sub ProgressionStatusbar()
    Dim i As Long
    Dim InitSB As Boolean
    Dim Indice As Integer
    Dim Debut As Date
 
    Debut = Now
    'Récupére la valeur de la barre d'état afin de pouvoir la redéfinir à son état initial
    'en fin de procédure.
    '(Renvoie True si la barre d'état est affichée, sinon False)
    InitSB = Application.DisplayStatusBar
    'Affiche la barre d'état si ce n'est pas déjà le cas
    Application.DisplayStatusBar = True
 
    'Exemple de boucle pour tester l'affichage dans la barre d'état.
    For i = 1 To 150000
        '
        'la procédure
        '
 
        '---
        If Debut <> Now Then
            Indice = Indice + 1
            Debut = Now
 
           If Indice > 10 Then Indice = 1
        End If
 
        Application.StatusBar = Application.Rept(Chr(7), Indice)
        'd'autres exemples de symboles pour le défilement dans la barre.
        'Application.StatusBar = Application.Rept(Chr(8), Indice)
        'Application.StatusBar = Application.Rept(Chr(62), Indice)
        '---
    Next
 
    'Restaure la donnée par défaut de la barre d'état
    Application.StatusBar = False
    'Réinintialise le mode d'affichage de la barre.
    Application.DisplayStatusBar = InitSB
End Sub

Worksheets("Feuil1").ShowDataForm
MsgBox "Fermeture du formulaire"