'Aide Excel (recherche le mot clé "Nouveautés")
Application.Assistance.SearchHelp "Nouveautés", ""

'Aide Excel (recherche le mot clé "SmartArt")
Application.Assistance.SearchHelp "SmartArt", ""

'Aide Excel (recherche le mot clé "filtre automatique")
Application.Assistance.SearchHelp "filtre automatique", ""

'Aide VBA (recherche le mot clé "SearchHelp")
Application.Assistance.SearchHelp "SearchHelp", "DEV"

Public Const HH_HELP_CONTEXT = &HF
Public Const HH_DISPLAY_TOPIC = &H0
 
Public Declare Function HtmlHelp Lib "HHCtrl.ocx" Alias "HtmlHelpA" _
(ByVal lhwndCaller As Long, ByVal sFileName As String, _
ByVal lCommand As Long, ByVal lData As Any) As Long
 
Sub utiliserAidePerso_V01()
Dim Fichier As String
 
Fichier = "C:\dossier\NomfichierAide.chm"
Call HtmlHelp(0, Fichier, HH_DISPLAY_TOPIC, "IDH_genere_multiplong.htm")
End Sub

Sub utiliserAidePerso_V02()
Shell _
"hh.exe mk:@MSITStore:C:\dossier\NomfichierAide.chm::/IDH_config_Transfert.htm", _
vbNormalFocus
End Sub

Sub utiliserAidePerso_V03()
'il est important d'indiquer un HelpContext correct.
'(identificateur de contexte associé à la rubrique d'aide).
'Si la valeur est erronée ou omise c'est une fenêtre d'aide Excel vide qui s'affiche.
Application.Help "C:\dossier\NomfichierAide.chm", 1
End Sub

Sub FermetureExcel()
    Dim Wb As Workbook
    
    For Each Wb In Application.Workbooks
        'Enregistre les modifications
        Wb.Save
        
        'Si vous remplacez Wb.Save par:
        'Wb.Saved = True
        'l'application se fermera sans demande d'enregistrement
    Next Wb

    Application.Quit
End Sub

Sub ListePolices()
    Dim Police As CommandBarComboBox
    Dim i As Integer
	    
    Set Police = Application.CommandBars.FindControl(id:=1728)
    
    With Worksheets("Feuil1")
        For i = 1 To Police.ListCount
            .Cells(i, 1) = Police.List(i)
            .Cells(i, 1).Font.Name = Police.List(i)
        Next i
    End With
End Sub

 
Application.Calculation = xlCalculationManual

 
Application.CellDragAndDrop = True

 
Application.EnableCancelKey = xlDisabled

 
Application.Interactive = False

 
Application.CutCopyMode = False

  
Application.DisplayAlerts = False

 
Application.ScreenUpdating = False

Application.OnKey "^{p}", "Gestion"

Dim WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)

End Sub

Application.CheckSpelling CustomDictionary:="PERSO.DIC", IgnoreUppercase:=False, AlwaysSuggest:=True

Private Function MotExiste(ByVal strMot As String) As Boolean
    MotExiste = Application.CheckSpelling(strMot, "PERSO.DIC", False)
End Function

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

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 "http://excel.developpez.com/sources/"
                    Case 2
                    ThisWorkbook.FollowHyperlink "http://www.developpez.net/forums/forumdisplay.php?f=542"
                    Case 3
                    ThisWorkbook.FollowHyperlink "http://vb.developpez.com/faqvba/"
                    Case 4
                    ThisWorkbook.FollowHyperlink "http://vb.developpez.com/cours/"
                End Select
                
                Exit For
            End If
        Next
    End With
    
    Assistant.Visible = False

End Sub

Sub Test()
   Shell "osk.exe"
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    If Button = 2 Then Shell "osk.exe"
End Sub

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

 
Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    If Button = 2 Then
        ShellExecute Me.hwnd, "open", "osk.exe", "", "", 1
    End If
End Sub

Sub VersionLinguistique()
    Dim x As Long
    
    x = Application.International(xlCountryCode)
    
    Select Case x
        Case Is = 1: MsgBox "English"
        Case Is = 33: MsgBox "Français"
        '
        '...
        '
        
        'Arabic                966       (Saudi Arabia)
        'Czech                 42        (Czech Republic)
        'Danish                45        (Denmark)
        'Dutch                 31        (The Netherlands)
        'Farsi                 98        (Iran)
        'Finnish               358       (Finland)
        'German                49        (Germany)
        'Greek                 30        (Greece)
        'Hebrew                972       (Israel)
        'Hungarian             36        (Hungary)
        'Indian                91        (India)
        'Italian               39        (Italy)
        'Japanese              81        (Japan)
        'Korean                82        (Korea)
        'Norwegian             47        (Norway)
        'Polish                48        (Poland)
        'Portuguese (Brazil)   55        (Brazil)
        'Portuguese            351       (Portugal)
        'Russian               7         (Russian Federation)
        'Simplified Chinese    86        (People's Republic of China)
        'Spanish               34        (Spain)
        'Swedish               46        (Sweden)
        'Thai                  66        (Thailand)
        'Traditional Chinese   886       (Taiwan)
        'Turkish               90        (Turkey)
        'Urdu                  92        (Pakistan)
        'Vietnamese            84        (Vietnam)
    End Select
End Sub