Convertir une Macro en Vbs

Le
Ralf Meuser
Salut à tous


J'ai régulièrement un fichier cvs à convertir en Excel. Sur le Net j'ai
trouvé un script pour le faire.
Ce tableau est à retraiter par la suite. Gràce à JB, j'ai maintenant une
macro pour le faire.

Maintenant je voudrais savoir si c'est possible de faire le traitement de la
macro dans le Vbs directement.

Merci d'avance pour votre aide.
Encore une petit chose. Je ne connais pas grand chose en Vbs et Macro, donc
donnez moi beaucoup d' explications dans vos reponses. J'ai déjà cherché une
demi journée pour faire marcher la macro, pourtant j'avais le code.

Voici mon Vbs et la macro.

salutations

Ralf


--
*** Vbs

'************************************************
' File: ExcelCSV2.vbs (WSH sample in VBScript)
' Author: (c) Günter Born (last edit 5-April-1999)
'
' A modified VBScript sample which demonstrates how to
' import a CSV file (with several separators like commas,
' semicolon, etc.) into a new sheet. We use the import wizard
' to avoid the trouble that CSV files with comma delimiters
' are getting read into the first column (a little bit tricky,
' but I was not able to get Open method to accept the format
' properties - they was ignored).
'
' Well, here we go:
' Launch Excel, add a worksheet, import the CSV file
' select the current worksheet, read some cell
' values back into the script, print the CSV content
' and terminate.
'
' Names.csv is a simple text file created with an editor
' using the following structure:
'
' Name:STRING,ID:INT
' Born,123
' Miller,728
' Myers,1334
' McFyer,789
' Thommy,345
'
' Here I have used a comma as a field separator. The CSV file Names.csv
' must be located in the same folder as the script for this example.
'
' In no way shall the author be liable for any
' losses or damages resulting from the use of this
' program. Use AS-IS at your own risk.
'
' The code is the property of the author. You may
' use the code and modify it, as far as this header
' remains intact. Further updates and other samples
' may be found on my site mentioned above.
' This sample was derived from samples shown in my book:
' Inside Windows Scripting Host, MS Press Germany
'
' Check out Born's Windows Scripting Host Bazaar at:
' http://ourworld.compuserve.com/homepages/Guenter_Born/index0.htm
''************************************************
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName

Title = "WSH sample - by G. Born"

' here you may set the name of the file to be imported
file = "S:UnifaceKPI04.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file=
Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))


' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods .
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes = Array(1,1,1,2,1,2,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI04.xls"
objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"


' I like to prevent the warning message about the unsaved data
' during closing Excel
' objXL.DisplayAlerts = False ' prevent all message boxes

objXl.Quit() ' Quit Excel
Set objXL = Nothing

WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function
'*************************************************
'*** End -> WSH-VBScript ***
'*************************************************



--
*** Macro
--
Sub KPI4_groupement()
ActiveWorkbook.Names.Add Name:="MaBd",
RefersTo:=Sheets(1).[A1].CurrentRegion
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" &
ThisWorkbook.Path & "" & ThisWorkbook.Name
Sql = "SELECT ANNEE,MOIS,CLIENT,NOM,GRP_CLI,sum(CA) as TCA,sum(MB) as
TMB,sum(NBR_POS) as TNBR_POS,sum(PB) as TPB,sum(PT) as TPT From MaBD Group
BY ANNEE,MOIS,CLIENT,NOM,GRP_CLI"
Set rs = cnn.Execute(Sql)
i = 2
Do While Not rs.EOF
Sheets(3).Cells(i, 1) = rs("ANNEE")
Sheets(3).Cells(i, 2) = rs("MOIS")
Sheets(3).Cells(i, 3) = rs("CLIENT")
Sheets(3).Cells(i, 4) = rs("NOM")
Sheets(3).Cells(i, 5) = rs("GRP_CLI")
Sheets(3).Cells(i, 6) = rs("TCA")
Sheets(3).Cells(i, 7) = rs("TMB")
Sheets(3).Cells(i, 8) = rs("TNBR_POS")
Sheets(3).Cells(i, 9) = rs("TPB")
Sheets(3).Cells(i, 8) = rs("TPT")
rs.MoveNext
i = i + 1
Loop
rs.Close
cnn.Close
Set rs = Nothing
End Sub
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
MichDenis
Le #4814451
Si tu veux exécuter une macro qui existe déjà dans
un fichier Excel dans un script VBS, pourquoi ne
pas appeler simplement cette macro dans le script vbs

Un exemple de code que tu copies dans un fichier NotePad
et que tu enregistre avec l'extension de fichier .vbs

A ) j'ai supposé que ta macro était dans un module standard
B ) Évidemment, tu dois remplacer le chemin et le nom du fichier
dans le script
C ) Indique correctement le nom de la macro du fichier à exécuter
D ) Afin de sauvegarder les informations, ton fichier ne doit pas être
ouvert. Afin d'éviter toute confusion, tu peux utiliser un fichier
dédier expressément à cette tâche !
E ) Tu fais tes tests et lorsque le résultat est à la hauteur de tes attentes
tu peux faire fi de cette ligne de code : Xl.Visible = True
l'exécution deviendra transparente aux yeux de l'usager.

Dim Xl
dim wk
Set Xl = WScript.CreateObject("EXCEL.application")
Xl.Visible = True
Xl.enableeventsúlse
set Wk = Xl.workbooks.open("c:atestmacro.xls")
Xl.Run "NOMDELAMACRO"
xl.save
xl.close



"Ralf Meuser" 46aef8f5$0$21527$
Salut à tous


J'ai régulièrement un fichier cvs à convertir en Excel. Sur le Net j'ai
trouvé un script pour le faire.
Ce tableau est à retraiter par la suite. Gràce à JB, j'ai maintenant une
macro pour le faire.

Maintenant je voudrais savoir si c'est possible de faire le traitement de la
macro dans le Vbs directement.

Merci d'avance pour votre aide.
Encore une petit chose. Je ne connais pas grand chose en Vbs et Macro, donc
donnez moi beaucoup d' explications dans vos reponses. J'ai déjà cherché une
demi journée pour faire marcher la macro, pourtant j'avais le code.

Voici mon Vbs et la macro.

salutations

Ralf


--------------------
*** Vbs
---------------------
'************************************************
' File: ExcelCSV2.vbs (WSH sample in VBScript)
' Author: (c) Günter Born (last edit 5-April-1999)
'
' A modified VBScript sample which demonstrates how to
' import a CSV file (with several separators like commas,
' semicolon, etc.) into a new sheet. We use the import wizard
' to avoid the trouble that CSV files with comma delimiters
' are getting read into the first column (a little bit tricky,
' but I was not able to get Open method to accept the format
' properties - they was ignored).
'
' Well, here we go:
' Launch Excel, add a worksheet, import the CSV file
' select the current worksheet, read some cell
' values back into the script, print the CSV content
' and terminate.
'
' Names.csv is a simple text file created with an editor
' using the following structure:
'
' Name:STRING,ID:INT
' Born,123
' Miller,728
' Myers,1334
' McFyer,789
' Thommy,345
'
' Here I have used a comma as a field separator. The CSV file Names.csv
' must be located in the same folder as the script for this example.
'
' In no way shall the author be liable for any
' losses or damages resulting from the use of this
' program. Use AS-IS at your own risk.
'
' The code is the property of the author. You may
' use the code and modify it, as far as this header
' remains intact. Further updates and other samples
' may be found on my site mentioned above.
' This sample was derived from samples shown in my book:
' Inside Windows Scripting Host, MS Press Germany
'
' Check out Born's Windows Scripting Host Bazaar at:
' http://ourworld.compuserve.com/homepages/Guenter_Born/index0.htm
''************************************************
Option Explicit
Const vbNormal = 1 ' window style

DIM objXL, objWb, objR, objTab ' Excel object variables
DIM Title, Text, tmp, i, j, file, name, FileName

Title = "WSH sample - by G. Born"

' here you may set the name of the file to be imported
file = "S:UnifaceKPI04.TXT" ' must be located in the script folder

' create an Excel object reference
Set objXL = WScript.CreateObject ("Excel.Application")

' set the Excel window properties (not absolutely necessary)
objXL.WindowState = vbNormal ' Normal
objXL.Height = 300 ' height
objXL.Width = 400 ' width
objXL.Left = 40 ' X-Position
objXL.Top = 20 ' Y-Position
objXL.Visible = true ' show window

' Create new Workbook (needed for import the CSV file Set objWb = objXl.WorkBooks.Add

' Get the first loaded worksheet object of the current workbook
Set objWb = objXL.ActiveWorkBook.WorkSheets(1)
objWb.Activate ' not absolutely necessary (for CSV)
' Now invoke the import wizard

'Set objTab = objWb.QueryTables.Add ("TEXT;"+GetPath + file,
objWb.Range("A1"))
Set objTab = objWb.QueryTables.Add ("TEXT;"+file, objWb.Range("A1"))


' here comes the mumbo jumbo to set all the properties for the wizard
' Oh Microsoft, how do I wish to has a With feature or a possibility to
' pass named arguments to methods ....
objTab.Name = "Names"
objTab.FieldNames = True
objTab.RowNumbers = False
objTab.FillAdjacentFormulas = False
objTab.PreserveFormatting = True
objTab.RefreshOnFileOpen = False
objTab.RefreshStyle = 1 'xlInsertDeleteCells
objTab.SavePassword = False
objTab.SaveData = True
objTab.AdjustColumnWidth = True
objTab.RefreshPeriod = 0
objTab.TextFilePromptOnRefresh = False
objTab.TextFilePlatform = 2 'xlWindows
objTab.TextFileStartRow = 1
objTab.TextFileParseType = 1 'xlDelimited
objTab.TextFileTextQualifier = -4142 ' xlTextQualifierNone
objTab.TextFileConsecutiveDelimiter = False
objTab.TextFileTabDelimiter = False ' ### my delimiters
objTab.TextFileSemicolonDelimiter = True
objTab.TextFileCommaDelimiter = False
objTab.TextFileSpaceDelimiter = False
objTab.TextFileColumnDataTypes = Array(1,1,1,2,1,2,1,1,1,1,1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
objTab.Refresh False

'WScript.Echo "We have loaded the worksheet"

' demonstrate how to read the column header values
Text = "Worksheet " + objWb.name + vbCRLF
Text = Text + "Column titles" + vbCRLF
Text = Text + CStr(objWb.Cells(1, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(1, 2).Value) + vbCRLF

' show some cell values (using the "hard coded method")
Text = Text + CStr(objWb.Cells(2, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(2, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(3, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(3, 2).Value) + vbCRLF
Text = Text + CStr(objWb.Cells(4, 1).Value) + vbTab
Text = Text + CStr(objWb.Cells(4, 2).Value) + vbCRLF

'' Show results
'MsgBox Text, vbOkOnly+ vbInformation, Title
'objXL.ActiveSheet.PrintOut ' print Worksheet
'WScript.Echo "We are printing, close after printing"

' save as now
FileName = GetPath + "KPI04.xls"
objXL.ActiveWorkbook.SaveAs FileName
'WScript.Echo "We are saving now"


' I like to prevent the warning message about the unsaved data
' during closing Excel
' objXL.DisplayAlerts = False ' prevent all message boxes

objXl.Quit() ' Quit Excel
Set objXL = Nothing

WScript.Quit()

'##########################
Function GetPath
' Retrieve the script path
DIM path
path = WScript.ScriptFullName ' Script name
GetPath = Left(path, InstrRev(path, ""))
End Function
'*************************************************
'*** End -> WSH-VBScript ***
'*************************************************



-----------------------------
*** Macro
-----------------------------
Sub KPI4_groupement()
ActiveWorkbook.Names.Add Name:="MaBd",
RefersTo:=Sheets(1).[A1].CurrentRegion
Dim rs As ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" &
ThisWorkbook.Path & "" & ThisWorkbook.Name
Sql = "SELECT ANNEE,MOIS,CLIENT,NOM,GRP_CLI,sum(CA) as TCA,sum(MB) as
TMB,sum(NBR_POS) as TNBR_POS,sum(PB) as TPB,sum(PT) as TPT From MaBD Group
BY ANNEE,MOIS,CLIENT,NOM,GRP_CLI"
Set rs = cnn.Execute(Sql)
i = 2
Do While Not rs.EOF
Sheets(3).Cells(i, 1) = rs("ANNEE")
Sheets(3).Cells(i, 2) = rs("MOIS")
Sheets(3).Cells(i, 3) = rs("CLIENT")
Sheets(3).Cells(i, 4) = rs("NOM")
Sheets(3).Cells(i, 5) = rs("GRP_CLI")
Sheets(3).Cells(i, 6) = rs("TCA")
Sheets(3).Cells(i, 7) = rs("TMB")
Sheets(3).Cells(i, 8) = rs("TNBR_POS")
Sheets(3).Cells(i, 9) = rs("TPB")
Sheets(3).Cells(i, 8) = rs("TPT")
rs.MoveNext
i = i + 1
Loop
rs.Close
cnn.Close
Set rs = Nothing
End Sub
Publicité
Poster une réponse
Anonyme