Vba en vbs

Le
Fredo P
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Gilles LAURENT [MVP]
Le #17747561
"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.
Le #17754471
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]" 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
Le #17829791
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

A = objWorkSheet.Cells(Lg, Col).Address
Prc = "Campagne " & Year(Date) & " / " & Year(Date) + 1 & Chr(10) & Prc _
& Chr(10) & GetValue(P, F, S, A)
A = objWorkSheet.Cells(Lg + 1, Col).Address
Prc = Prc & Chr(10) & GetValue(P, F, S, A)
MsgBox Prc
excel.ScreenUpdating = True

' *********************************
' *********************************
End Sub
' *********************************

' *********************************
Private Function GetValue(Path, File, Sheet, Ref)
' *********************************
' *********************************


'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
' *********************************

[/code]


"Fredo P" 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



Publicité
Poster une réponse
Anonyme