creer un clavier virtuel

Sub Clavier()
    Shell "C:\WINDOWS\system32\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

Sub TestCLAVIER_V()
ShellExecute 0, "open", "osk.exe", "", "", 1
End Sub

Sub TestCLAVIER_V()
Dim RetVal
Select Case Application.OperatingSystem
Case "Windows (32-bit) NT 6.00"
ShellExecute 0, "open", "osk.exe", 0, 0, 1
Case Else
RetVal = Shell("C:\WINDOWS\system32\osk.exe", 1)
End Select
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

Sub CLAVIERVIRTUEL()
Dim strOS$, tOS$: Dim RetVaL
strOS = Application.OperatingSystem
tOS = Trim(Mid(strOS, InStr(1, strOS, ")") + 1, 255))
    Select Case tOS
        Case "NT 6.00"
        ShellExecute 0, "open", "osk.exe", 0, 0, 1
        Case "NT 5.01"
        RetVaL = Shell("C:\WINDOWS\system32\osk.exe", 1)
    End Select
End Sub

Sub tmptool()
Dim tpo As CommandBar, Btn1 As CommandBarButton
deltool
On Error Resume Next
Set tpo = Application.CommandBars.Add("Clavier virtuel")
With tpo
    .Position = msoBarTop
    Set Btn1 = .Controls.Add(msoControlButton)
    With Btn1
      .Style = msoButtonIconAndCaptionBelow
      .Caption = "Lancer le clavier."
      .FaceId = 728
      .OnAction = "CLAVIERVIRTUEL"
    End With
    .Visible = True
  End With
End Sub

Sub deltool()
On Error Resume Next
Application.CommandBars("Clavier virtuel").Delete
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call deltool
End Sub
Private Sub Workbook_Open()
Call tmptool
End Sub

Sub tmptool()
Dim tpo As CommandBarButton
resetbo
On Error Resume Next
Set tpo = Application.CommandBars("Standard").Controls. _
Add(Type:=msoControlButton)
With tpo
    .Style = msoButtonIcon
    .FaceId = 728
    .OnAction = "CLAVIERVIRTUEL"
    .TooltipText = "Lance le clavier virtuel."
End With
End Sub

Sub resetbo()
'permet de rétablir la barre d'outils Standard
Application.CommandBars("Standard").Reset
End Sub

Sub tmptool()
Dim tpo As CommandBarButton
resetbo
On Error Resume Next
Set tpo = Application.CommandBars("Standard").Controls. _
Add(Type:=msoControlButton, before:=22)
With tpo
    .Style = msoButtonIcon
    .FaceId = 728
    .OnAction = "CLAVIERVIRTUEL"
    .TooltipText = "Lance le clavier virtuel."
End With
End Sub

Sub resetbo()
'permet de rétablir la barre d'outils Standard
Application.CommandBars("Standard").Reset
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
resetbo
End Sub

Private Sub Workbook_Open()
tmptool
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
'*********************************************
Sub CLAVIERVIRTUEL()
Dim strOS$, tOS$: Dim RetVaL
strOS = Application.OperatingSystem
tOS = Trim(Mid(strOS, InStr(1, strOS, ")") + 1, 255))
    Select Case tOS
        Case "NT 6.00"
        ShellExecute 0, "open", "osk.exe", 0, 0, 1
        Case "NT 5.01"
        RetVaL = Shell("C:\WINDOWS\system32\osk.exe", 1)
    End Select
End Sub
'*********************************************
Sub tmptool()
Dim tpo As CommandBarButton
resetbo
On Error Resume Next
Set tpo = Application.CommandBars("Standard").Controls. _
Add(Type:=msoControlButton)
With tpo
    .Style = msoButtonIcon
    .FaceId = 728
    .OnAction = "CLAVIERVIRTUEL"
    .TooltipText = "Lance le clavier virtuel."
End With
End Sub
'*********************************************
Sub resetbo()
'permet de rétablir la barre d'outils Standard
Application.CommandBars("Standard").Reset
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
resetbo
End Sub
'*********************************************
Private Sub Workbook_Open()
tmptool
End Sub

Sub Clavier()
    Shell "C:\WINDOWS\system32\osk.exe"
End Sub