jeanluc065
Messages postés134Date d'inscriptionsamedi 23 septembre 2006StatutMembreDernière intervention 1 juin 2007
-
1 oct. 2006 à 09:17
jeanluc065
Messages postés134Date d'inscriptionsamedi 23 septembre 2006StatutMembreDernière intervention 1 juin 2007
-
1 oct. 2006 à 15:19
Bonjour,
En access 2002, j'utilise un code ( fourni aimablement par JMO, un participant de ce site ) et je voudrais y ajouter
1 - la création d'une feuille qui devrait se nommer "référence".
2 - l'affichage d'un sablier (ou un message ) jusque la fin de l'exécution
Qui peut m'aider svp ?
Merci d'avance
JL
Function ShowFolderList(Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers: Set Dossiers = fso.GetFolder(Path)
Dim fichiers: Set fichiers = Dossiers.Files
Dim fichier, f, strListe
For Each fichier In fichiers
Set f = fso.GetFile(fichier)
If fso.GetExtensionName(fichier) = "xls" Then
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application")
Set objClasseur = objExcel.Workbooks.Open(fichier)
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 avant modification"
objClasseur.Sheets(3).Name = "id1"
objClasseur.Sheets(4).Name = "id2"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"
objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201827 1 oct. 2006 à 09:34
Bonjour ,
Proposition à la 2ème question:
Pour faire patienter l'utilisateur lors de traitement "long", et comme
il n'y a pas de Progressbar en vbs, je contourne de la façcon suivante:
' ################## AFFICHER UNE FENETRE D'INFORMATION
strComputer = "."
Set objWMIService = GetObject("Winmgmts:\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Left = (intHorizontal - 800) / 2
objExplorer.Top = (intVertical - 100) / 2
objExplorer.Width = 500
objExplorer.Height = 180
objExplorer.Visible = 1
objExplorer.Document.Body.Style.Cursor = "wait"
objExplorer.Document.Title = fic & " - " & Now
objExplorer.Document.Body.InnerHTML = "
Création du fichier
""" &_
fic & """
en cours , merci de patienter.
"
''''''''''''''''''''''''''''''''''''''''''
' ici les traitements à effectuer
'''''''''''''''''''''''''''''''''''''''''''''
' ################## FERMER LA FENETRE
objExplorer.Document.Body.Style.Cursor = "default"
objExplorer.Quit
Set objExplorer = Nothing
Set colItems = Nothing
Set objWMIService = Nothing
Quand à la 1ère question, je n'ai pas tout compris !!!
Avec Access 2002, "création d'une feuille qui devrait se nommer "référence" ???
jeanluc065
Messages postés134Date d'inscriptionsamedi 23 septembre 2006StatutMembreDernière intervention 1 juin 2007 1 oct. 2006 à 09:52
Bonjour Jean-Marc,
précision 2ème question :
le code, il s'agit de la procédure pour renommer des feuilles existantes contenues dans les fichiers xls d'un répertoire.
Ce que je souhaiterais en plus, c'est de créer une nouvelle feuille qui s'appellerait "référence" et ce dans chaque fichier .xls
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201827 1 oct. 2006 à 10:40
Re,
Concernant les fichiers .xls (à renommer), ceux-ci peuvent-ils contenir plusieurs Feuilles
ou tous contiennent une feuil1 que tu renommes, puis,
si Feuil2 existe, tu la renommes en "référence" et si feuil2 n'existe pas, tu la créés (.add) ???
jeanluc065
Messages postés134Date d'inscriptionsamedi 23 septembre 2006StatutMembreDernière intervention 1 juin 2007 1 oct. 2006 à 12:03
Re,
effectivement, tous mes fichiers contiennent plusieurs feuilles mais je sais d'avance, selon le type de fichiers, combien j'ai de feuilles.
par exemple , dans un fichier où j'ai 4 feuilles, je devrais en créer une 5ème qui s'appelera "référence".
Merci Jean-Marc.
jl
Vous n’avez pas trouvé la réponse que vous recherchez ?
MsgBox "Nom de la Feuil1 : " & objClasseur.Sheets(1).Name &vbCrLf&_
"Nombre de feuilles : " & objExcel.Sheets.Count,,"Nom de la Feuil1 avant modification"
If objClasseur.Sheets(1).Name <> Replace(f.Name, ".xls","") Then
objClasseur.Sheets(1).Name = Replace(f.Name, ".xls","")
End If
'WScript.Sleep "500"
MsgBox "Nom de la Feuil1 : " & objClasseur.Sheets(1).Name &vbCrLf&_
"Nombre de feuilles" & objExcel.Sheets.Count,,"Nom de la Feuil1 après modification"
'Ajout d'une feuille - elle devient donc active
objExcel.ActiveWorkbook.Sheets.Add
'Renommer la derniere feuille
objExcel.ActiveWorkbook.Sheets(objExcel.Sheets.Count).Name = "Référence"
MsgBox "Nom de la dernière feuille " & objClasseur.Sheets(objExcel.Sheets.Count).Name,,"Ajout de la feuille <Référence>"
jeanluc065
Messages postés134Date d'inscriptionsamedi 23 septembre 2006StatutMembreDernière intervention 1 juin 2007 1 oct. 2006 à 15:19
Rerere Jean-Marc,
Dans ma fonction existante qui renomme mes feuilles 3 et 4 de tous mes fichiers xls, je ne vois pas ou et comment intégrer ta modification pour ajouter le nouvelle feuille ( qui sera en fait la 6ème ) qui devrait s'appeler "référence".
Comme tu le proposes, ajouter une feuille1 à celle déjà existante, quelque soit le nombre de feuilles présentes, c'est la meilleure solution bien sûr.
voici ma fonction complète, où intégrer ta modif ?
Function ShowFolderListprox(Path)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossiers: Set Dossiers = fso.GetFolder(Path)
Dim fichiers: Set fichiers = Dossiers.Files
Dim fichier, f, strListe
For Each fichier In fichiers
Set f = fso.GetFile(fichier)
If fso.GetExtensionName(fichier) = "xls" Then
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application")
Set objClasseur = objExcel.Workbooks.Open(fichier)
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 avant modification"
objClasseur.Sheets(3).Name = "ident1"
objClasseur.Sheets(4).Name = "ident2"
'WScript.Sleep "500"
'MsgBox objClasseur.Sheets(1).Name,,"Nom de la Feuil1 après modification"
objExcel.ActiveWorkbook.SaveAs fichier 'sauvegarde sous le même nom
objExcel.ActiveWorkbook.Saved = True 'sauvegarde true=oui false=non
'objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
Set objExcel = Nothing
Set objClasseur = Nothing
End If
Next
Set f = Nothing
Set fichiers = Nothing
Set Dossiers = Nothing
Set fso = Nothing