Bonjour
Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut
être modifier en vbs?
Sub Rech_Parc()
Dim P As String, F As String, S As String, A As String, R As Byte
Dim C As Byte, Prc$, Col As Byte, Lg As Byte, Resu$
P = "D:\Documents and Settings\Frédéric\Mes documents"
F = "suivi_agricole.xls"
S = "assol"
Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7")
R = 3
For C = 3 To 22
A = Cells(R, C).Address
If GetValue(P, F, S, A) = Prc Then
Col = C
Exit For
End If
Next C
C = 2
For R = 6 To 38 Step 2
A = Cells(R, C).Address
Resu = GetValue(P, F, S, A)
If Resu = Year(Date) & " / " & Year(Date) + 1 Then
Lg = R
Exit For
End If
Next R
A = Cells(Lg, Col).Address
Prc = "Campagne " & Year(Date) & " / " & Year(Date) + 1 & Chr(10) & Prc
& Chr(10) & GetValue(P, F, S, A)
A = Cells(Lg + 1, Col).Address
Prc = Prc & Chr(10) & GetValue(P, F, S, A)
MsgBox Prc
Application.ScreenUpdating = True
End Sub
Private Function GetValue(Path, File, Sheet, Ref)
Dim Arg As String
'Vérie l'existence du fichier, ajoute les séparateurs manquants
If Right(Path, 1) <> "\" Then Path = Path & "\"
If Dir(Path & File) = "" Then
GetValue = "File Not Found"
Exit Function
End If
'Crée l'argument '"D:\mesdocuments\loisirs\[vacances.xls]Méribel'!R4C3"
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref) _
.Range("A1").Address(, , xlR1C1)
'Exécute la macro XLM
GetValue = ExecuteExcel4Macro(Arg)
End Function
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Gilles LAURENT [MVP]
"Fredo P" wrote:
Bonjour
Bonsoir,
Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut être modifier en vbs?
[...]
D'une manière général, un script VBA peut facilement être traduit en VBS. En revanche, dans votre exemple, le script VBA fait plusieurs appels à des macros Excel ... Pouvez-vous spécifier votre besoin ?
-- Gilles LAURENT MVP Windows Server - Admin Frameworks http://glsft.free.fr
"Fredo P" wrote:
Bonjour
Bonsoir,
Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut
être modifier en vbs?
[...]
D'une manière général, un script VBA peut facilement être traduit en VBS. En
revanche, dans votre exemple, le script VBA fait plusieurs appels à des
macros Excel ... Pouvez-vous spécifier votre besoin ?
--
Gilles LAURENT
MVP Windows Server - Admin Frameworks
http://glsft.free.fr
Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut être modifier en vbs?
[...]
D'une manière général, un script VBA peut facilement être traduit en VBS. En revanche, dans votre exemple, le script VBA fait plusieurs appels à des macros Excel ... Pouvez-vous spécifier votre besoin ?
-- Gilles LAURENT MVP Windows Server - Admin Frameworks http://glsft.free.fr
Fredo P.
Bonjour Effectivement ,il a 2 procédures que l'on peut grouper en une seule. Je souhaite mettre en place un raccourci sur le bureau afin d'obtenir une information rapide sur le contenu d'une feuille Excel nommée "Assol" du classeur "Suivi_agricole.xls". Le Rem présent dans le code (Méribel) n'a en rien, une relation avec le sujet. "Gilles LAURENT [MVP]" a écrit dans le message de news:
"Fredo P" wrote:
> Bonjour
Bonsoir,
> Novice en vbs, est que qq pourrait me dire si le code vba si dessous
peut
> être modifier en vbs? [...]
D'une manière général, un script VBA peut facilement être traduit en VBS.
En
revanche, dans votre exemple, le script VBA fait plusieurs appels à des macros Excel ... Pouvez-vous spécifier votre besoin ?
-- Gilles LAURENT MVP Windows Server - Admin Frameworks http://glsft.free.fr
Bonjour
Effectivement ,il a 2 procédures que l'on peut grouper en une seule.
Je souhaite mettre en place un raccourci sur le bureau afin d'obtenir une
information rapide sur le contenu d'une feuille Excel nommée "Assol" du
classeur "Suivi_agricole.xls".
Le Rem présent dans le code (Méribel) n'a en rien, une relation avec le
sujet.
"Gilles LAURENT [MVP]" <glsft@free.fr> a écrit dans le message de
news:1CE72CE2-44BC-47DC-B590-CB9C3D85A0DF@microsoft.com...
"Fredo P" wrote:
> Bonjour
Bonsoir,
> Novice en vbs, est que qq pourrait me dire si le code vba si dessous
peut
> être modifier en vbs?
[...]
D'une manière général, un script VBA peut facilement être traduit en VBS.
En
revanche, dans votre exemple, le script VBA fait plusieurs appels à des
macros Excel ... Pouvez-vous spécifier votre besoin ?
--
Gilles LAURENT
MVP Windows Server - Admin Frameworks
http://glsft.free.fr
Bonjour Effectivement ,il a 2 procédures que l'on peut grouper en une seule. Je souhaite mettre en place un raccourci sur le bureau afin d'obtenir une information rapide sur le contenu d'une feuille Excel nommée "Assol" du classeur "Suivi_agricole.xls". Le Rem présent dans le code (Méribel) n'a en rien, une relation avec le sujet. "Gilles LAURENT [MVP]" a écrit dans le message de news:
"Fredo P" wrote:
> Bonjour
Bonsoir,
> Novice en vbs, est que qq pourrait me dire si le code vba si dessous
peut
> être modifier en vbs? [...]
D'une manière général, un script VBA peut facilement être traduit en VBS.
En
revanche, dans votre exemple, le script VBA fait plusieurs appels à des macros Excel ... Pouvez-vous spécifier votre besoin ?
-- Gilles LAURENT MVP Windows Server - Admin Frameworks http://glsft.free.fr
Stéphane CARDIN
Bonjour, voilà ce que ça pourrait donné (non testé) :
[code]
Set fso=CreateObject("Scripting.FileSystemObject")
P = "D:Documents and SettingsFrédéricMes documents" F = "suivi_agricole.xls" S = "assol"
If Not fso.FolderExists(P) Then Wscript.Echo "Le chemin spécifié '" & P & "' n'éxiste pas!!!" : Wscript.Quit
'Vérie l'existence du fichier, ajoute les séparateurs manquants If Right(P, 1) <> "" Then P = P & "" If Not fso.FileExists(P & F) Then Wscript.Echo "Le fichier cible '" & P & F & "' n'éxiste pas!!!" : Wscript.Quit
Rech_Parc()
objWorkbook.Close() excel.Quit Wscript.Quit
' ********************************* Sub Rech_Parc() ' ********************************* ' *********************************
Set excel=CreateObject("Excel.Application") Set objWorkbook=excel.Workbooks.Open(P & F) Set objWorksheet=objWorkbook.Worksheets(1)
Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7") R = 3
For C = 3 To 22 A = objWorkSheet.Cells(R, C).Address
If GetValue(P, F, S, A) = Prc Then Col = C Exit For End If Next
C = 2
For R = 6 To 38 Step 2 A = objWorkSheet.Cells(R, C).Address Resu = GetValue(P, F, S, A)
If Resu = Year(Date) & " / " & Year(Date) + 1 Then Lg = R Exit For End If Next
'Exécute la macro XLM GetValue = ExecuteExcel4Macro(Arg)
' ********************************* ' ********************************* End Function ' *********************************
[/code]
"Fredo P" a écrit dans le message de groupe de discussion :
Bonjour Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut être modifier en vbs? Sub Rech_Parc() Dim P As String, F As String, S As String, A As String, R As Byte Dim C As Byte, Prc$, Col As Byte, Lg As Byte, Resu$ P = "D:Documents and SettingsFrédéricMes documents" F = "suivi_agricole.xls" S = "assol" Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7") R = 3 For C = 3 To 22 A = Cells(R, C).Address If GetValue(P, F, S, A) = Prc Then Col = C Exit For End If Next C C = 2 For R = 6 To 38 Step 2 A = Cells(R, C).Address Resu = GetValue(P, F, S, A) If Resu = Year(Date) & " / " & Year(Date) + 1 Then Lg = R Exit For End If Next R A = Cells(Lg, Col).Address Prc = "Campagne " & Year(Date) & " / " & Year(Date) + 1 & Chr(10) & Prc & Chr(10) & GetValue(P, F, S, A) A = Cells(Lg + 1, Col).Address Prc = Prc & Chr(10) & GetValue(P, F, S, A) MsgBox Prc Application.ScreenUpdating = True End Sub
Private Function GetValue(Path, File, Sheet, Ref) Dim Arg As String 'Vérie l'existence du fichier, ajoute les séparateurs manquants If Right(Path, 1) <> "" Then Path = Path & "" If Dir(Path & File) = "" Then GetValue = "File Not Found" Exit Function End If 'Crée l'argument '"D:mesdocumentsloisirs[vacances.xls]Méribel'!R4C3" Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref) _ .Range("A1").Address(, , xlR1C1) 'Exécute la macro XLM GetValue = ExecuteExcel4Macro(Arg) End Function
Bonjour, voilà ce que ça pourrait donné (non testé) :
[code]
Set fso=CreateObject("Scripting.FileSystemObject")
P = "D:Documents and SettingsFrédéricMes documents"
F = "suivi_agricole.xls"
S = "assol"
If Not fso.FolderExists(P) Then Wscript.Echo "Le chemin spécifié '" & P & "'
n'éxiste pas!!!" : Wscript.Quit
'Vérie l'existence du fichier, ajoute les séparateurs manquants
If Right(P, 1) <> "" Then P = P & ""
If Not fso.FileExists(P & F) Then Wscript.Echo "Le fichier cible '" & P & F
& "' n'éxiste pas!!!" : Wscript.Quit
Rech_Parc()
objWorkbook.Close()
excel.Quit
Wscript.Quit
' *********************************
Sub Rech_Parc()
' *********************************
' *********************************
Set excel=CreateObject("Excel.Application")
Set objWorkbook=excel.Workbooks.Open(P & F)
Set objWorksheet=objWorkbook.Worksheets(1)
Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7")
R = 3
For C = 3 To 22
A = objWorkSheet.Cells(R, C).Address
If GetValue(P, F, S, A) = Prc Then
Col = C
Exit For
End If
Next
C = 2
For R = 6 To 38 Step 2
A = objWorkSheet.Cells(R, C).Address
Resu = GetValue(P, F, S, A)
If Resu = Year(Date) & " / " & Year(Date) + 1 Then
Lg = R
Exit For
End If
Next
'Exécute la macro XLM
GetValue = ExecuteExcel4Macro(Arg)
' *********************************
' *********************************
End Function
' *********************************
[/code]
"Fredo P" <ponsinet.frederic363etdesbrouettes@orange.fr> a écrit dans le
message de groupe de discussion : u6U7agnPJHA.496@TK2MSFTNGP05.phx.gbl...
Bonjour
Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut
être modifier en vbs?
Sub Rech_Parc()
Dim P As String, F As String, S As String, A As String, R As Byte
Dim C As Byte, Prc$, Col As Byte, Lg As Byte, Resu$
P = "D:Documents and SettingsFrédéricMes documents"
F = "suivi_agricole.xls"
S = "assol"
Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7")
R = 3
For C = 3 To 22
A = Cells(R, C).Address
If GetValue(P, F, S, A) = Prc Then
Col = C
Exit For
End If
Next C
C = 2
For R = 6 To 38 Step 2
A = Cells(R, C).Address
Resu = GetValue(P, F, S, A)
If Resu = Year(Date) & " / " & Year(Date) + 1 Then
Lg = R
Exit For
End If
Next R
A = Cells(Lg, Col).Address
Prc = "Campagne " & Year(Date) & " / " & Year(Date) + 1 & Chr(10) &
Prc & Chr(10) & GetValue(P, F, S, A)
A = Cells(Lg + 1, Col).Address
Prc = Prc & Chr(10) & GetValue(P, F, S, A)
MsgBox Prc
Application.ScreenUpdating = True
End Sub
Private Function GetValue(Path, File, Sheet, Ref)
Dim Arg As String
'Vérie l'existence du fichier, ajoute les séparateurs manquants
If Right(Path, 1) <> "" Then Path = Path & ""
If Dir(Path & File) = "" Then
GetValue = "File Not Found"
Exit Function
End If
'Crée l'argument '"D:mesdocumentsloisirs[vacances.xls]Méribel'!R4C3"
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref) _
.Range("A1").Address(, , xlR1C1)
'Exécute la macro XLM
GetValue = ExecuteExcel4Macro(Arg)
End Function
Bonjour, voilà ce que ça pourrait donné (non testé) :
[code]
Set fso=CreateObject("Scripting.FileSystemObject")
P = "D:Documents and SettingsFrédéricMes documents" F = "suivi_agricole.xls" S = "assol"
If Not fso.FolderExists(P) Then Wscript.Echo "Le chemin spécifié '" & P & "' n'éxiste pas!!!" : Wscript.Quit
'Vérie l'existence du fichier, ajoute les séparateurs manquants If Right(P, 1) <> "" Then P = P & "" If Not fso.FileExists(P & F) Then Wscript.Echo "Le fichier cible '" & P & F & "' n'éxiste pas!!!" : Wscript.Quit
Rech_Parc()
objWorkbook.Close() excel.Quit Wscript.Quit
' ********************************* Sub Rech_Parc() ' ********************************* ' *********************************
Set excel=CreateObject("Excel.Application") Set objWorkbook=excel.Workbooks.Open(P & F) Set objWorksheet=objWorkbook.Worksheets(1)
Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7") R = 3
For C = 3 To 22 A = objWorkSheet.Cells(R, C).Address
If GetValue(P, F, S, A) = Prc Then Col = C Exit For End If Next
C = 2
For R = 6 To 38 Step 2 A = objWorkSheet.Cells(R, C).Address Resu = GetValue(P, F, S, A)
If Resu = Year(Date) & " / " & Year(Date) + 1 Then Lg = R Exit For End If Next
'Exécute la macro XLM GetValue = ExecuteExcel4Macro(Arg)
' ********************************* ' ********************************* End Function ' *********************************
[/code]
"Fredo P" a écrit dans le message de groupe de discussion :
Bonjour Novice en vbs, est que qq pourrait me dire si le code vba si dessous peut être modifier en vbs? Sub Rech_Parc() Dim P As String, F As String, S As String, A As String, R As Byte Dim C As Byte, Prc$, Col As Byte, Lg As Byte, Resu$ P = "D:Documents and SettingsFrédéricMes documents" F = "suivi_agricole.xls" S = "assol" Prc = Inputbox("quelle parcelle", "Nom complet de la parcelle", "S7") R = 3 For C = 3 To 22 A = Cells(R, C).Address If GetValue(P, F, S, A) = Prc Then Col = C Exit For End If Next C C = 2 For R = 6 To 38 Step 2 A = Cells(R, C).Address Resu = GetValue(P, F, S, A) If Resu = Year(Date) & " / " & Year(Date) + 1 Then Lg = R Exit For End If Next R A = Cells(Lg, Col).Address Prc = "Campagne " & Year(Date) & " / " & Year(Date) + 1 & Chr(10) & Prc & Chr(10) & GetValue(P, F, S, A) A = Cells(Lg + 1, Col).Address Prc = Prc & Chr(10) & GetValue(P, F, S, A) MsgBox Prc Application.ScreenUpdating = True End Sub
Private Function GetValue(Path, File, Sheet, Ref) Dim Arg As String 'Vérie l'existence du fichier, ajoute les séparateurs manquants If Right(Path, 1) <> "" Then Path = Path & "" If Dir(Path & File) = "" Then GetValue = "File Not Found" Exit Function End If 'Crée l'argument '"D:mesdocumentsloisirs[vacances.xls]Méribel'!R4C3" Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" & Range(Ref) _ .Range("A1").Address(, , xlR1C1) 'Exécute la macro XLM GetValue = ExecuteExcel4Macro(Arg) End Function
