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
84
85
86
87
88
89
90
91
92
93
94
| Option Compare Text
Option Explicit
Public Path As String
Public TailleReel As String
'Public TextFile, Taille As String ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
Public Txtpath As String, Tpath As String, TxtDest As String
Public Txtname As String, Txtnameshort As String, Extension As String
Public F1 As Integer ' String
'Private Const BIF_RETURNONLYFSDIRS = 1 ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Const BIF_DONTGOBELOWDOMAIN = 2 ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'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 ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" _
' (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, _
' lpDirectory As Any, ByVal nShowCmd As Long) As Long ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
' ByVal lpBuffer As String) As Long ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
' ByVal lpString2 As String) As Long ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
'Private Type BrowseInfo ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
' hwndOwner As Long
' pIDLRoot As Long
' pszDisplayName As Long
' lpszTitle As Long
' ulFlags As Long
' lpfnCallback As Long
' lParam As Long
' iImage As Long
'End Type
'Private Declare Sub InitCommonControls Lib "comctl32.dll" () ' <-*-*-*-*-*-*-*- non utilisé dans le code soumis -*-*-*-*-*-*-
Function FindAndReplace(ByVal strInString As String, strFindString As String, strReplaceString As String) As String
Dim intPtr As Integer
If Len(strFindString) > 0 Then 'catch if try to find empty string
Do
intPtr = InStr(strInString, strFindString)
If intPtr > 0 Then
FindAndReplace = FindAndReplace & Left(strInString, intPtr - 1) & strReplaceString
strInString = Mid(strInString, intPtr + Len(strFindString))
End If
Loop While intPtr > 0
End If
FindAndReplace = FindAndReplace & strInString
End Function
Sub Command1_Click()
On Error GoTo error_handler
' -*-*-*-*-*-*-*- l'erreur commence ici car la variable était déclarée String alors que -*-*-*-*-
' -*-*-*-*-*-*-**-*-*-*-*-*-*- FreeFile renvoie un Integer -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
F1 = FreeFile
Tpath = App.Path & "\"
With dlg
.DialogTitle = "Select a file" 'titre de la boite
.FileName = "*.*" 'on recherche un fichier d'extension txt
.InitDir = "D:\LocalData\" 'repertoire par defaut
.CancelError = True 'pour ne pas partir en erreur si on click sur annuler
.ShowOpen
End With
Txtpath = dlg.FileName
Txtname = dlg.FileTitle
TailleReel = Len(Txtpath) - Len(Txtname)
TxtDest = Left(Txtpath, TailleReel)
Extension = Right(Txtname, 4)
Txtnameshort = FindAndReplace(Txtname, Extension, "")
'Creation du FI.bat
' -*-*-*-*-*-*-*- l'erreur était déclenché ici car la variable F1 était déclarée String -*-*-*-*-*-*-
Open Tpath & "F1.bat" For Output As #F1
Print #F1, "nconvert -out jpeg -dpi 300 -resize 1004 708 -o Phenix_" & Txtnameshort & ".jpg " & Txtname
Close #F1
'FileCopy Tpath & "nconvert.exe", TxtDest & "nconvert.exe"
FileCopy Txtpath, Tpath & Txtname
'Shell (Tpath & "F1.bat")' < -*-*- erreur de syntaxe
Shell Tpath & "F1.bat"
Exit Sub
error_handler: ' récupère l'erreur renvoyer si l'utilisateur clique sur annulé
If Err.Number = 32755 Then
MsgBox "Please select a file"
'Exit Sub ' <--------- inutile
End If
End Sub |
Shell pour fichier .bat Nconvert
Répondre avec citation
Balises[CODE]...[/CODE]
en fin de discussion, quand vous avez obtenu l'aide attendue.
......... et pourquoi pas, pour remercier, un 
pour celui/ceux qui vous ont dépannés.
Partager