OVH Cloud OVH Cloud

Vbs qui pilote Excel

16 réponses
Avatar
sympatix
Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer dans une
variable (A), le texte contenu dans 6 cellules horizontales (dans mon cas,
A2, à F2), de la première feuille (et unique) d'un fichier Excel, et refaire
ça à chaque fois pour les 6 cellules en dessous (donc, A3 à F3, puis A4 à
F4, etc...), j'usqu'à la fin du fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte, chaque
ligne à la fois, pour pouvoir les traiter individuellement par la suite).

Pour l'instant tout ce que je sais faire, c'est ouvrir le fichier Excel (je
sais, c'est peu..., mais je ne suis pas trop familiarisé avec EXcel
Application)

----------------
Fichier = "F:\toto.xls"
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Visible = True
oXL.Workbooks.Open Fichier
----------------

Merci d'avance
Cordialement
Sympatix

6 réponses

1 2
Avatar
Michel Pierron
Re Sympatix;
Donne un exemple des données formatées telles que tu souhaites les récupérer
dans un fichier texte.
(cf: "Value1" "Value2" etc.)
MP

"sympatix" a écrit dans le message de
news:
bonjour !

Je ne sais pas si c'est moi qui suis difficile, mais ce n'est pas encore
ça

!
J'aimerais faire ça avec l'objet Excel.Application, car avec l'objet
ADODB.Connection, j'ai du mal à suivre, et comme je ne comprends pas ce
que

je fais, je ne peux pas triturer les code à ma guise, et ça me mets mal à
l'aise !

Je pense que je vais reformuler ma question différement, avec un message
transmis également sur excel.fr

Merci
Cortdialement
Sympatix

"Michel Pierron" a écrit dans le message de
news:
Bonjour sympatix;

Dim sDrv, sSce, sTgt, oRec, i
Dim oDb, sDbc, sSql, oTxt, sVal

sDrv = "C:"
sSce = sDrv & "ClasseurDeTest.xls"
sTgt = sDrv & "ClasseurDeTest.Txt"

Set oDb = CreateObject("ADODB.Connection")
sDbc = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
sDbc = sDbc & sSce & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
oDb.Open sDbc

Set oRec = CreateObject("ADODB.RecordSet")
oRec.CursorType = 1
oRec.LockType = 3

' Remplacer "Feuil1" par le nom réel de la feuille
sSql = "SELECT * FROM [Feuil1$]"
oRec.Open sSql, oDb

If Not oRec.EOF Then
oRec.MoveLast
oRec.MoveFirst
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set oTxt = fso.CreateTextFile(sTgt, True)
Do While Not oRec.EOF
For i = 0 To oRec.Fields.Count - 1
' Adapter le séparateur ";" selon vos critères
If i Then
sVal = sVal & ";""" & oRec.Fields(i) & """"
Else
sVal = """" & oRec.Fields(i) & """"
End If
Next
oTxt.WriteLine (sVal)
oRec.MoveNext
Loop
End If

oRec.Close
oDb.Close
oTxt.Close

MsgBox "Done !", 64, "Excel Reader"
Wscript.Quit

MP

"sympatix" a écrit dans le message de
news:
Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer
dans



une
variable (A), le texte contenu dans 6 cellules horizontales (dans mon
cas,


A2, à F2), de la première feuille (et unique) d'un fichier Excel, et
refaire

ça à chaque fois pour les 6 cellules en dessous (donc, A3 à F3, puis
A4



à
F4, etc...), j'usqu'à la fin du fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte,
chaque



ligne à la fois, pour pouvoir les traiter individuellement par la
suite).



Pour l'instant tout ce que je sais faire, c'est ouvrir le fichier
Excel



(je
sais, c'est peu..., mais je ne suis pas trop familiarisé avec EXcel
Application)

----------------
Fichier = "F:toto.xls"
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Visible = True
oXL.Workbooks.Open Fichier
----------------

Merci d'avance
Cordialement
Sympatix





















Avatar
Jean-Claude BELLAMY
Dans le message news: ,
sympatix s'est ainsi exprimé:

Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer
dans une variable (A), le texte contenu dans 6 cellules horizontales
(dans mon cas, A2, à F2), de la première feuille (et unique) d'un
fichier Excel, et refaire ça à chaque fois pour les 6 cellules en
dessous (donc, A3 à F3, puis A4 à F4, etc...), j'usqu'à la fin du
fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte,
chaque ligne à la fois, pour pouvoir les traiter individuellement par
la suite).



Essaye ce qui suit ...
J'ai testé, çà fonctionne ...
NB: pour arrêter l'exploration du fichier EXCEL, j'ai prévu une cellule de
"stop" dont le contenu est "###"
A toi d'adapter

J'ai prévu aussi le cas où une cellule contient du texte sur plusieurs
lignes (obtenues dans Excel par ALT-ENTER)
Je remplace le caractère 0x0A (Line Feed seul) par un espace.
Là aussi tu peux adapter ...

Le script attends 2 paramètres :
- le nom du fichier Excel à analyser
- le nom du fichier texte à créer

"ReadExcel.vbs"
--------- couper ici ---------
CellFin="###"
Set args = Wscript.Arguments
nbargs=args.count
if nbargs<2 then wscript.quit
Srce=args(0)
Dest=args(1)
Set fso=WScript.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(Srce) then
wscript.echo "Fichier " & Srce & " inexistant"
wscript.quit
end if
Set ts = fso.CreateTextFile(Dest, True)
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Workbooks.Open Srce
NumL=2
Finúlse
Do
s=""
For NumC = 1 To 6
If s<>"" Then s=s & " "
CurCell=oXL.Cells(NumL,NumC).Value
Curcell=Replace(Curcell,chr(10)," ")
If CurcellÎllFin Then Fin=true Else s=s+CurCell
Next
ts.WriteLine(s)
If not Fin then NumL=NumL+1
Loop Until Fin
ts.Close
oXL.Quit
wscript.echo NumL & " lignes récupérées"
--------- couper ici ---------


--
May the Force be with You!
La Connaissance s'accroît quand on la partage
----------------------------------------------------------
Jean-Claude BELLAMY [MVP] - http://www.bellamyjc.org
*

Avatar
Michel Pierron
Re sympatix;
Avec Excel.Application (il te faut adapter le séparateur:
Set oXL = WScript.CreateObject("EXCEL.application")
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set oTxt = fso.CreateTextFile("C:ClasseurDeTest.txt", True)

With oXL
.Workbooks.Open "C:ClasseurDeTest.xls"
Do
y=y+1
If .ActiveSheet.Cells(y, 1)="" then exit do
For i= 1 to 6 ' Nombre de colonnes
If i>1 then
sVal = sVal & " """ & .ActiveSheet.Cells(y,i) & """"
Else
sVal = """" & .ActiveSheet.Cells(y,i) & """"
End If
Next
oTxt.WriteLine (sVal)
Loop
oTxt.Close
.Quit
End With
Set oXL = Nothing
MsgBox "Done !",64

MP

"sympatix" a écrit dans le message de
news:
bonjour !

Je ne sais pas si c'est moi qui suis difficile, mais ce n'est pas encore
ça

!
J'aimerais faire ça avec l'objet Excel.Application, car avec l'objet
ADODB.Connection, j'ai du mal à suivre, et comme je ne comprends pas ce
que

je fais, je ne peux pas triturer les code à ma guise, et ça me mets mal à
l'aise !

Je pense que je vais reformuler ma question différement, avec un message
transmis également sur excel.fr

Merci
Cortdialement
Sympatix

"Michel Pierron" a écrit dans le message de
news:
Bonjour sympatix;

Dim sDrv, sSce, sTgt, oRec, i
Dim oDb, sDbc, sSql, oTxt, sVal

sDrv = "C:"
sSce = sDrv & "ClasseurDeTest.xls"
sTgt = sDrv & "ClasseurDeTest.Txt"

Set oDb = CreateObject("ADODB.Connection")
sDbc = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
sDbc = sDbc & sSce & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
oDb.Open sDbc

Set oRec = CreateObject("ADODB.RecordSet")
oRec.CursorType = 1
oRec.LockType = 3

' Remplacer "Feuil1" par le nom réel de la feuille
sSql = "SELECT * FROM [Feuil1$]"
oRec.Open sSql, oDb

If Not oRec.EOF Then
oRec.MoveLast
oRec.MoveFirst
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set oTxt = fso.CreateTextFile(sTgt, True)
Do While Not oRec.EOF
For i = 0 To oRec.Fields.Count - 1
' Adapter le séparateur ";" selon vos critères
If i Then
sVal = sVal & ";""" & oRec.Fields(i) & """"
Else
sVal = """" & oRec.Fields(i) & """"
End If
Next
oTxt.WriteLine (sVal)
oRec.MoveNext
Loop
End If

oRec.Close
oDb.Close
oTxt.Close

MsgBox "Done !", 64, "Excel Reader"
Wscript.Quit

MP

"sympatix" a écrit dans le message de
news:
Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer
dans



une
variable (A), le texte contenu dans 6 cellules horizontales (dans mon
cas,


A2, à F2), de la première feuille (et unique) d'un fichier Excel, et
refaire

ça à chaque fois pour les 6 cellules en dessous (donc, A3 à F3, puis
A4



à
F4, etc...), j'usqu'à la fin du fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte,
chaque



ligne à la fois, pour pouvoir les traiter individuellement par la
suite).



Pour l'instant tout ce que je sais faire, c'est ouvrir le fichier
Excel



(je
sais, c'est peu..., mais je ne suis pas trop familiarisé avec EXcel
Application)

----------------
Fichier = "F:toto.xls"
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Visible = True
oXL.Workbooks.Open Fichier
----------------

Merci d'avance
Cordialement
Sympatix





















Avatar
sympatix
Bonjour !

ça marche impec. Ma variable stocke bien à chaque passage de boucle les
valeurs des lignes en question. Et c'est ce que je voulais.
Merci !
Cordialement
Sympatix

"Jean-Claude BELLAMY" a écrit dans le
message de news:uem$
Dans le message news: ,
sympatix s'est ainsi exprimé:

Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer
dans une variable (A), le texte contenu dans 6 cellules horizontales
(dans mon cas, A2, à F2), de la première feuille (et unique) d'un
fichier Excel, et refaire ça à chaque fois pour les 6 cellules en
dessous (donc, A3 à F3, puis A4 à F4, etc...), j'usqu'à la fin du
fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte,
chaque ligne à la fois, pour pouvoir les traiter individuellement par
la suite).



Essaye ce qui suit ...
J'ai testé, çà fonctionne ...
NB: pour arrêter l'exploration du fichier EXCEL, j'ai prévu une cellule de
"stop" dont le contenu est "###"
A toi d'adapter

J'ai prévu aussi le cas où une cellule contient du texte sur plusieurs
lignes (obtenues dans Excel par ALT-ENTER)
Je remplace le caractère 0x0A (Line Feed seul) par un espace.
Là aussi tu peux adapter ...

Le script attends 2 paramètres :
- le nom du fichier Excel à analyser
- le nom du fichier texte à créer

"ReadExcel.vbs"
--------- couper ici ---------
CellFin="###"
Set args = Wscript.Arguments
nbargs=args.count
if nbargs<2 then wscript.quit
Srce=args(0)
Dest=args(1)
Set fso=WScript.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(Srce) then
wscript.echo "Fichier " & Srce & " inexistant"
wscript.quit
end if
Set ts = fso.CreateTextFile(Dest, True)
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Workbooks.Open Srce
NumL=2
Finúlse
Do
s=""
For NumC = 1 To 6
If s<>"" Then s=s & " "
CurCell=oXL.Cells(NumL,NumC).Value
Curcell=Replace(Curcell,chr(10)," ")
If CurcellÎllFin Then Fin=true Else s=s+CurCell
Next
ts.WriteLine(s)
If not Fin then NumL=NumL+1
Loop Until Fin
ts.Close
oXL.Quit
wscript.echo NumL & " lignes récupérées"
--------- couper ici ---------


--
May the Force be with You!
La Connaissance s'accroît quand on la partage
----------------------------------------------------------
Jean-Claude BELLAMY [MVP] - http://www.bellamyjc.org
*





Avatar
sympatix
Bonjour et bonne année !
Merci !


Comme tu peux le vois dans ma réponce à JC Bellamy, j'ai enfin trouvé ce que
je voulais.
Je garde quand même ton bout de code pour ma culture Vbscriptienne !

Cordialement
Sympatix

"Isabelle Prawitz" a écrit dans le message de
news:
Bonjour et bonne année !

Par exemple

dim MaCell as range
set MaCell¬tiveSheet.Range("A2")
Do while MaCell.value<>""
'Traitement de ma ligne Excel
set MaCell=MaCell.offset(1,0) 'décalage vers le bas
loop

Pour le traitement sur la ligne, ça dépend ce que tu veux faire (même
traitement pour toutes les colonnes ou pas !)

Si le traitement est différent, tu peux avoir :
valMaCell=MaCell.value
'Traitement valMaCell
valMaCell=MaCell.offset(0,1).value 'cellule à droite
'Traitement valMaCell
valMaCell=MaCell.offset(0,2).value 'cellule 2 à droite
'Traitement valMaCell
etc...

A+
Isa

"sympatix" a écrit dans le message de
news:

bonjour !

Je t'ai fait suivre par mail un script VBS qui modifie tous les
fichiers



Excel de plusieurs sous répertoires. Pour commencer j'ai commencé par
faire une macro sous excel puis adapter en vbscript.


Merci...mais, je n'arrive pas à y trouver mon bonheur (je n'ai aucune
expérience en vb d'Excel...)
(Il me faudrais simplement un truc dans le genre (en bon français ;-)

-----Ce que je voudrais, reste à traduire en script /ON------
For Each Ligne de ma feuille active Excel
Ma_variable = La_valeur_de_la _Ligne_de_la_Feuille_Excel
Blablabal...mes instructions...blablabla
Next
-----Ce que je voudrais, reste à traduire en script /OFF------

(à titre d'infos, je met en copier-coller en dessous, le code que tu
m'as


envoyé par mail)
Cordialement
Sympatix

-----------------------------
Dim oFSO
Dim oFolder, oSubFolder, oFIle
Dim oXL

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder > > oFSO.GetFolder("C:CELYAEasyPHPwwwcovapuserfilesrootAdherents")
Set oXL = WScript.CreateObject("EXCEL.application")

For each oSubFolder In oFolder.SubFolders
For each oFile In oSubFolder.Files
If InStr(LCase(oFile.Name), "restealivrer") > 0 Then
oXL.Workbooks.Open oFile.path
oXL.Visible = True
oXL.screenupdatingúlse
oXL.Sheets(1).Select

oXL.Sheets(1).PageSetup.PrintTitleRows = "$1:$1"
oXL.Sheets(1).PageSetup.PrintTitleColumns = ""
oXL.Sheets(1).PageSetup.PrintArea = ""

oXL.Sheets(1).PageSetup.LeftHeader = ""
oXL.Sheets(1).PageSetup.CenterHeader = ""
oXL.Sheets(1).PageSetup.RightHeader = ""
oXL.Sheets(1).PageSetup.LeftFooter = ""
oXL.Sheets(1).PageSetup.CenterFooter = "Page &P de &N"
oXL.Sheets(1).PageSetup.RightFooter = ""
oXL.Sheets(1).PageSetup.LeftMargin = 40 '42.5 points pour 1,5 cm
oXL.Sheets(1).PageSetup.RightMargin = 40
oXL.Sheets(1).PageSetup.TopMargin = 40
oXL.Sheets(1).PageSetup.BottomMargin = 40
oXL.Sheets(1).PageSetup.HeaderMargin = 14
oXL.Sheets(1).PageSetup.FooterMargin = 14
oXL.Sheets(1).PageSetup.PrintHeadings = False
oXL.Sheets(1).PageSetup.PrintGridlines = False
oXL.Sheets(1).PageSetup.PrintComments = -4142 'xlPrintNoComments
oXL.Sheets(1).PageSetup.PrintQuality = 600
oXL.Sheets(1).PageSetup.CenterHorizontally = False
oXL.Sheets(1).PageSetup.CenterVertically = False
oXL.Sheets(1).PageSetup.Orientation = 2 'xlLandscape
oXL.Sheets(1).PageSetup.Draft = False
oXL.Sheets(1).PageSetup.PaperSize = 9 'xlPaperA4
oXL.Sheets(1).PageSetup.FirstPageNumber = -4105 'xlAutomatic
oXL.Sheets(1).PageSetup.Order = 1 'xlDownThenOver
oXL.Sheets(1).PageSetup.BlackAndWhite = False
oXL.Sheets(1).PageSetup.Zoom = False
oXL.Sheets(1).PageSetup.FitToPagesWide = 1 'Adapter à la largeur
d'une


page
oXL.Sheets(1).PageSetup.FitToPagesTall = False
oXL.Sheets(1).PageSetup.PrintErrors = 0 'xlPrintErrorsDisplayed

oXL.cells(1,1).select
oXL.ActiveWorkbook.Save
oXL.ActiveWorkbook.close
End If
Next
Next

oXL.Application.Quit

-----------------------------











Avatar
sympatix
Re !

Merci pour ton code, je ne l'ai pas encore essayé (entre temps, voir ma
réponse à JCB, j'ai utilisé son code, en l'adaptant)
Je butais simplement sur mon ignorance du vocabulaire de VBA. Mais, bon, on
construit son expérience petit à petit !

Merci encore pour ton aide :-)

Cordialement
Sympatix

"Michel Pierron" a écrit dans le message de
news:
Re sympatix;
Avec Excel.Application (il te faut adapter le séparateur:
Set oXL = WScript.CreateObject("EXCEL.application")
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set oTxt = fso.CreateTextFile("C:ClasseurDeTest.txt", True)

With oXL
.Workbooks.Open "C:ClasseurDeTest.xls"
Do
y=y+1
If .ActiveSheet.Cells(y, 1)="" then exit do
For i= 1 to 6 ' Nombre de colonnes
If i>1 then
sVal = sVal & " """ & .ActiveSheet.Cells(y,i) & """"
Else
sVal = """" & .ActiveSheet.Cells(y,i) & """"
End If
Next
oTxt.WriteLine (sVal)
Loop
oTxt.Close
.Quit
End With
Set oXL = Nothing
MsgBox "Done !",64

MP

"sympatix" a écrit dans le message de
news:
bonjour !

Je ne sais pas si c'est moi qui suis difficile, mais ce n'est pas encore
ça

!
J'aimerais faire ça avec l'objet Excel.Application, car avec l'objet
ADODB.Connection, j'ai du mal à suivre, et comme je ne comprends pas ce
que

je fais, je ne peux pas triturer les code à ma guise, et ça me mets mal
à


l'aise !

Je pense que je vais reformuler ma question différement, avec un message
transmis également sur excel.fr

Merci
Cortdialement
Sympatix

"Michel Pierron" a écrit dans le message de
news:
Bonjour sympatix;

Dim sDrv, sSce, sTgt, oRec, i
Dim oDb, sDbc, sSql, oTxt, sVal

sDrv = "C:"
sSce = sDrv & "ClasseurDeTest.xls"
sTgt = sDrv & "ClasseurDeTest.Txt"

Set oDb = CreateObject("ADODB.Connection")
sDbc = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
sDbc = sDbc & sSce & ";Extended Properties=""Excel
8.0;HDR=Yes;IMEX=1"""



oDb.Open sDbc

Set oRec = CreateObject("ADODB.RecordSet")
oRec.CursorType = 1
oRec.LockType = 3

' Remplacer "Feuil1" par le nom réel de la feuille
sSql = "SELECT * FROM [Feuil1$]"
oRec.Open sSql, oDb

If Not oRec.EOF Then
oRec.MoveLast
oRec.MoveFirst
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set oTxt = fso.CreateTextFile(sTgt, True)
Do While Not oRec.EOF
For i = 0 To oRec.Fields.Count - 1
' Adapter le séparateur ";" selon vos critères
If i Then
sVal = sVal & ";""" & oRec.Fields(i) & """"
Else
sVal = """" & oRec.Fields(i) & """"
End If
Next
oTxt.WriteLine (sVal)
oRec.MoveNext
Loop
End If

oRec.Close
oDb.Close
oTxt.Close

MsgBox "Done !", 64, "Excel Reader"
Wscript.Quit

MP

"sympatix" a écrit dans le message de
news:
Bonjour !

Depuis un script VBS, je voudrais, à l'aide d'une boucle, récupérer
dans



une
variable (A), le texte contenu dans 6 cellules horizontales (dans
mon




cas,
A2, à F2), de la première feuille (et unique) d'un fichier Excel, et
refaire

ça à chaque fois pour les 6 cellules en dessous (donc, A3 à F3, puis
A4



à
F4, etc...), j'usqu'à la fin du fichier Excel.

(Mon but est en fait d'importer séparément dans un fichier texte,
chaque



ligne à la fois, pour pouvoir les traiter individuellement par la
suite).



Pour l'instant tout ce que je sais faire, c'est ouvrir le fichier
Excel



(je
sais, c'est peu..., mais je ne suis pas trop familiarisé avec EXcel
Application)

----------------
Fichier = "F:toto.xls"
Set oXL = WScript.CreateObject("EXCEL.application")
oXL.Visible = True
oXL.Workbooks.Open Fichier
----------------

Merci d'avance
Cordialement
Sympatix
























1 2