1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
|
Option Explicit
' On va tester notre Objet
' Private WithEvents mobjPerson As Person 'Provoque une erreur si placé ailleurs que dans un module de classe
'API nécessaires à l'extraction des paramètres de la ligne de commande:
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Dim param_1 As String
Dim param_2 As String
Dim param_3 As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
'Dim obj_cat1 As New Categorie
'============================================================================================
' EXTRACTION DES PARAMETRES DE LA LIGNE DE COMMANDE: |
' http://www.developpez.net/forums/d530333/logiciels/microsoft-office/excel/macros-vba-excel/recuperer-parametres-ligne-commande/
'============================================================================================
Dim CmdLine As String 'Ligne de Commande
Dim CmdArgs() As String 'Tableau des paramétres de Commande.
Dim ArgNb As Integer 'Nombre de paramétres
Dim Pos1 As Integer 'Variable pour stocker la position de certaines chaines.
Application.DisplayAlerts = False
'Lire la ligne de Commande: "C:\Program Files\MsOffice\Office11\Excel.exe" /e/Paramètre1/Paramètre2/Paramètre3 C:\MonDocument.xls'
CmdLine = GetCmd
'On détermine la position de la fin de la chaine d'arguments:
Pos1 = InStr(1, CmdLine, ThisWorkbook.FullName, vbTextCompare)
'Cette ligne extrait ce qui lance Excel et la suite d'arguments:
If Pos1 <> 0 Then CmdLine = Mid(CmdLine, 1, Pos1 - 1) Else Exit Sub
If Right(CmdLine, 1) = """" Then Pos1 = 2 Else Pos1 = 1
'Supprime l'espace en bout de chaine:
CmdLine = Mid(CmdLine, 1, Len(CmdLine) - Pos1)
'Supprimer la partie de la chaine contenant l'appel de Excel.exe puis le '/e/' pour n'avoir que les paramètres personnalisés:
CmdLine = Mid(CmdLine, InStr(1, CmdLine, " /e", vbTextCompare) + 4, Len(CmdLine)) & "/"
'Extraction des paramètres personnalisés et stockage dans un tableau redimensionnable:
Do Until Len(CmdLine) < 2
Pos1 = InStr(1, CmdLine, "/")
ArgNb = ArgNb + 1
ReDim Preserve CmdArgs(1 To ArgNb)
CmdArgs(ArgNb) = Mid(CmdLine, 1, Pos1 - 1)
CmdLine = Mid(CmdLine, Pos1 + 1, Len(CmdLine))
Loop
'============================================================================================
' FIN DE L'EXTRACTION DES PARAMETRES DE LA LIGNE DE COMMANDE. |
'============================================================================================
MsgBox "Le premier argument au lancement est: " & CmdArgs(1) & vbCr & CmdArgs(2) & vbCr & CmdArgs(3), vbInformation
param_1 = CmdArgs(1)
param_2 = CmdArgs(2)
param_3 = CmdArgs(3)
Ouvrir param_1, param_2, param_3
Application.Wait (Now + TimeValue("0:00:05"))
ThisWorkbook.Close (False) ' c'a me ferme bien le classeur mais pas instance d'excel qui à été ouverte ! ! !
' Dans Private Sub Workbook_BeforeClose(Cancel As Boolean) pour que c'a se ferme bine ! ! !
' Application.Quit
End Sub
Private Function GetCmd() As String 'Tony Proctor microsoft.public.vb.winapi
Dim lpCmd As Long
lpCmd = GetCommandLine()
GetCmd = Space$(lstrlen(ByVal lpCmd))
lstrcpy ByVal GetCmd, ByVal lpCmd
End Function |
Partager