Petit code en Vba
Résolu
S_D
Messages postés
24
Statut
Membre
-
S_D Messages postés 24 Statut Membre -
S_D Messages postés 24 Statut Membre -
Bonjour,
Voila plusieurs jours que je travaille sur une petite macro, sensee copier la case K5 d une serie de factures et ensuite de regrouper les infos ds un tableau.
Je vous Donne le Code, mais seule la partie en gras pose pb. C est vraiment bete comme truc, et j ai du laisser une erreur que je ne vois pas...... . merci beaucoup pour votre aide!
S_D
Sub checkbill()
'
' checkbill Macro
' Macro recorded 6/29/2009 by S_D
Application.WindowState = xlMinimized
Application.WindowState = xlNormal
ActiveWindow.WindowState = xlMinimized
ActiveWindow.WindowState = xlNormal
Const ctePourLecture = 1
Const ctePourEcrire = 2
Const ctePourAjouter = 8
Dim n As Integer
Dim celd
Dim cela
n = 1
Dim objFSO, objDossier, objFichier, objResultat
Dim Repertoire, NomFichierTxt
On Error Resume Next
Repertoire = "S:/SL/2009"
NomFichierTxt = "Resultat.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDossier = objFSO.GetFolder(Repertoire)
Set objResultat = objFSO.CreateTextFile((Repertoire & "\" & NomFichierTxt), ctePourEcrire)
'si le repertoire n est pas vide
If (objDossier.Files.Count > 0) Then
For Each objFichier In objDossier.Files
'si le fichier a une extension xls
'If (objFichier.FileFormat = xls) Then
'objResultat.WriteLine (objFichier.Name)
celd = Range("[objFichier.Name]sheet1!K5")
cela = Range("[S:/SL/approved_CMS/CM_2009.xls]sheet1!A1")
cela.Copy
celd.Offset(n, 1).Paste
n = n + 1
'End If
Next
End If
objResultat.Close
Set objResultat = Nothing
Set objDossier = Nothing
Set objFSO = Nothing
End Sub
Voila plusieurs jours que je travaille sur une petite macro, sensee copier la case K5 d une serie de factures et ensuite de regrouper les infos ds un tableau.
Je vous Donne le Code, mais seule la partie en gras pose pb. C est vraiment bete comme truc, et j ai du laisser une erreur que je ne vois pas...... . merci beaucoup pour votre aide!
S_D
Sub checkbill()
'
' checkbill Macro
' Macro recorded 6/29/2009 by S_D
Application.WindowState = xlMinimized
Application.WindowState = xlNormal
ActiveWindow.WindowState = xlMinimized
ActiveWindow.WindowState = xlNormal
Const ctePourLecture = 1
Const ctePourEcrire = 2
Const ctePourAjouter = 8
Dim n As Integer
Dim celd
Dim cela
n = 1
Dim objFSO, objDossier, objFichier, objResultat
Dim Repertoire, NomFichierTxt
On Error Resume Next
Repertoire = "S:/SL/2009"
NomFichierTxt = "Resultat.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDossier = objFSO.GetFolder(Repertoire)
Set objResultat = objFSO.CreateTextFile((Repertoire & "\" & NomFichierTxt), ctePourEcrire)
'si le repertoire n est pas vide
If (objDossier.Files.Count > 0) Then
For Each objFichier In objDossier.Files
'si le fichier a une extension xls
'If (objFichier.FileFormat = xls) Then
'objResultat.WriteLine (objFichier.Name)
celd = Range("[objFichier.Name]sheet1!K5")
cela = Range("[S:/SL/approved_CMS/CM_2009.xls]sheet1!A1")
cela.Copy
celd.Offset(n, 1).Paste
n = n + 1
'End If
Next
End If
objResultat.Close
Set objResultat = Nothing
Set objDossier = Nothing
Set objFSO = Nothing
End Sub
Configuration: Windows XP Internet Explorer 7.0
3 réponses
-
-
bonjour,
ça m'interesse de voir l'erreur.
si cela ne vous dérange pas? -
En fait , quand on beut utiliser une info situee sur un autre tableau, on doit l'ouvrir d'abord.
L'algo est le suivant
Boucle sur les fichiers presents ds le dossier
ouverture des fichiers
On fait nos petites affaires
fermetures des fichiers
Fin de la boucle