Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel ajouter date dans tous mes fichiers xls d'un même dossier

ajouter date dans tous mes fichiers xls d'un même dossier

15 réponses
Avatar
magic-dd
bonjour, j'ai une macro qui ne fonctionne pas bien concernant la mise
=E0 jour de date dans un de mes dossiers.

il est plac=E9 sur F:/FORMATION

Dans ce dossier, 35 fichiers xls

cela ne marche pas bien car il ne me le fait que sur 1 seul fichier

cerise sur le gateu , si je pouvais par un mpsgbox determiner le nom
du dossier que je souhaite exploiter cela serait superbe

genre :choisissez un mois puis apres indiquez la date.

merci

voici la commande

Sub test()
Dim inCalculationMode As Integer
Application.ScreenUpdating =3D False
inCalculationMode =3D Application.Calculation
Application.Calculation =3D xlCalculationManual
Dim Fich As String, Doss As Object, Parent As String
Dim FSO As Object, F As Object
Parent =3D "f:\"

Var =3D InputBox("Entrez une date au format jj/mm/aaaa")

If IsDate(Var) Then
Var =3D CDate(Var)
End If

Set FSO =3D CreateObject("scripting.FileSystemObject")
1 For Each Doss In FSO.getfolder(Parent).subfolders
For Each F In Doss.Files
Fich =3D F.Path
If Fich <> "" Then
If LCase(Mid(Fich, InStrRev(Fich, ".") + 1, 3)) =3D "xls"
Then
Workbooks.Open Fich
Do
If Var > 0 Then
ActiveSheet.Range("b41").Value =3D Var

Exit Do
End If

Exit Sub

Loop
'Sheets("extraction").PrintOut
ActiveWorkbook.Close False

Exit For
End If
End If
Next
Application.Calculation =3D inCalculationMode
Application.Calculation =3D xlAutomatic
Next Doss
Application.Calculation =3D inCalculationMode
Application.ScreenUpdating =3D True
Application.Calculation =3D xlAutomatic
End Sub
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
MichD
Bonjour,

Essaie d'être plus précis.

Que veux-tu faire?

Quel est ton (tes) critère qui déterminera le fichier du répertoire mentionné sur lequel
tu veux travailler?



MichD
---------------------------------------------------------------
Avatar
magic-dd
On 18 juin, 14:49, "MichD" wrote:
Bonjour,

Essaie d' tre plus pr cis.

Que veux-tu faire?

Quel est ton (tes) crit re qui d terminera le fichier du r pertoire menti onn sur lequel
tu veux travailler?

MichD
---------------------------------------------------------------



bonjour MichD

mon premier criter est de determiner dans quel dossier la macro va
s'effecftuer ex choix du mois

je lui dis NOVEMBRE

ensuite lui indiquer la date à inscrire dans chaque fichier de ce
dossier NOVEMBRE

dans mon dossier NOVEMBRE, comme dans tous les autres des mois de
l'année, se trouvent des fichiers nommes 1.xls jusqu'à 35.xls

dans chacuns de ces fichiers, il faut qu'en B41 soit inscrit la date
inscrite plus tot dans la Box

en esperant avoir été plus clair

merci
Avatar
magic-dd
bonjour
le premier critere est le choix du dossier contenant mes fichiers
xls.

ex NOVEMBRE

le second est d'inscrire une date qui sera noté dans chacun de ces
fichiers xls

chaque dossier mensuel contient 35 fichiers xls nommés de 1.xls à
35.xls.

merci
------------------------------------
Avatar
MichD
Essaie ceci dans un module standard :


'----------------------------------------------------------------------
Sub test()
Dim Chemin As String, Message As String
Dim S As Variant
Dim LaDate As Variant, Année As String
Dim Jour As String, Mois As String, Rep As String
Dim Fichier As String, Wk As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Do
LaDate = Application.InputBox(Prompt:="Saisissez une date" & _
vbCrLf & vbCrLf & _
"Respectez le format date suivant : Jour/Mois/Année", _
Title:="Choix de la date...", Type:=2)
'Si l'usager annule...
If LaDate = False Then MsgBox "Opération annulée.": Exit Sub
'si la fenêtre se referme vide
If LaDate = "" Then MsgBox "Opération annulée.": Exit Sub
S = Split(LaDate, "/")
Jour = S(0)
Mois = S(1)
Année = S(2)
If IsDate(LaDate) Then
If CDate(LaDate) = DateSerial(Année, Mois, Jour) Then
ok = True
Else
MsgBox "problème avec la date saisie. Recommencer."
End If
Else
MsgBox "Le format demandé n'a pas été respecté. Recommencer."
End If
Loop Until ok = True

'Ce qui s'affichera dans la fenêtre
Message = "Sélectionner un des répertoires affichés"
'Répertoire de départ à l'ouverture de la fenêtre
'à toi de le définir si nécessaire...
Rep = Application.DefaultFilePath
's'assurer que l'on est sur le bon lecteur
ChDrive Left(Rep, 1)
Chemin = ChoixDossier(Rep)
If Chemin = "" Then
MsgBox "Vous avez annulé votre choix. Opération annulée"
End If

Fichier = Dir(Chemin & "" & "*.xl*")

Do While Fichier <> ""
Set Wk = Workbooks.Open(Chemin & "" & Fichier)
With Wk.ActiveSheet.Range("B41")
If CLng(.Value) <> CLng(CDate(LaDate)) Then
.NumberFormat = "DD/MM/YY"
.Value = CLng(CDate(LaDate))
Wk.Close True
Else
Wk.Close
End If
End With
Fichier = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'----------------------------------------------------------------------
Function ChoixDossier(Rep As String)
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'----------------------------------------------------------------------

MichD
---------------------------------------------------------------
Avatar
MichD
Correction dans la dernière section :

Utilise plutôt ceci :


Do While Fichier <> ""
Set Wk = Workbooks.Open(Chemin & "" & Fichier)
With Wk.ActiveSheet.Range("B41")
If CLng(.Value) <> CLng(CDate(LaDate)) Then
.NumberFormat = "DD/MM/YY"
.Value = CLng(CDate(LaDate))
Wk.Close True
Else
Wk.Close False
End If
End With
Set Wk = Nothing
Fichier = Dir()
Loop




MichD
---------------------------------------------------------------
"MichD" a écrit dans le message de groupe de discussion :
jrnet4$seu$


Essaie ceci dans un module standard :


'----------------------------------------------------------------------
Sub test()
Dim Chemin As String, Message As String
Dim S As Variant
Dim LaDate As Variant, Année As String
Dim Jour As String, Mois As String, Rep As String
Dim Fichier As String, Wk As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Do
LaDate = Application.InputBox(Prompt:="Saisissez une date" & _
vbCrLf & vbCrLf & _
"Respectez le format date suivant : Jour/Mois/Année", _
Title:="Choix de la date...", Type:=2)
'Si l'usager annule...
If LaDate = False Then MsgBox "Opération annulée.": Exit Sub
'si la fenêtre se referme vide
If LaDate = "" Then MsgBox "Opération annulée.": Exit Sub
S = Split(LaDate, "/")
Jour = S(0)
Mois = S(1)
Année = S(2)
If IsDate(LaDate) Then
If CDate(LaDate) = DateSerial(Année, Mois, Jour) Then
ok = True
Else
MsgBox "problème avec la date saisie. Recommencer."
End If
Else
MsgBox "Le format demandé n'a pas été respecté. Recommencer."
End If
Loop Until ok = True

'Ce qui s'affichera dans la fenêtre
Message = "Sélectionner un des répertoires affichés"
'Répertoire de départ à l'ouverture de la fenêtre
'à toi de le définir si nécessaire...
Rep = Application.DefaultFilePath
's'assurer que l'on est sur le bon lecteur
ChDrive Left(Rep, 1)
Chemin = ChoixDossier(Rep)
If Chemin = "" Then
MsgBox "Vous avez annulé votre choix. Opération annulée"
End If

Fichier = Dir(Chemin & "" & "*.xl*")

Do While Fichier <> ""
Set Wk = Workbooks.Open(Chemin & "" & Fichier)
With Wk.ActiveSheet.Range("B41")
If CLng(.Value) <> CLng(CDate(LaDate)) Then
.NumberFormat = "DD/MM/YY"
.Value = CLng(CDate(LaDate))
Wk.Close True
Else
Wk.Close
End If
End With
Fichier = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'----------------------------------------------------------------------
Function ChoixDossier(Rep As String)
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'----------------------------------------------------------------------

MichD
---------------------------------------------------------------
Avatar
Gloops
magic-dd a écrit, le 18/06/2012 14:40 :
cerise sur le gateu , si je pouvais par un mpsgbox determiner le nom
du dossier que je souhaite exploiter cela serait superbe



Bonjour,

Pour choisir un répertoire, certes on peut utiliser InputBox à condit ion
que l'utilisateur ne se trompe pas sur l'orthographe du répertoire (et
des répertoires parents), mais on pourra être intéressé de regard er du
côté de Application.BrowseForFolder.

D'ailleurs, voilà quelqu'un qui trouve ça tellement pratique qu'il ou vre
carrément Excel pour le faire depuis une autre application :

http://www.vbaexpress.com/kb/getarticle.php?kb_id(4

Peut-être qu'il pousse un peu loin et qu'il se donnerait moins de mal e n
appelant une API, mais enfin c'est histoire de dire qu'Excel sait faire.
Avatar
magic-dd
On 18 juin, 16:47, "MichD" wrote:
Correction dans la derni re section :

Utilise plut t ceci :

Do While Fichier <> ""
    Set Wk = Workbooks.Open(Chemin & "" & Fichier)
    With Wk.ActiveSheet.Range("B41")
        If CLng(.Value) <> CLng(CDate(LaDate)) Then
            .NumberFormat = "DD/MM/YY"
            .Value = CLng(CDate(LaDate))
            Wk.Close True
        Else
            Wk.Close False
        End If
    End With
    Set Wk = Nothing
    Fichier = Dir()
Loop

MichD
---------------------------------------------------------------
"MichD"  a crit dans le message de groupe de discussion :
jrnet4$

Essaie ceci dans un module standard :

'----------------------------------------------------------------------
Sub test()
Dim Chemin As String, Message As String
Dim  S As Variant
Dim LaDate As Variant, Ann e As String
Dim Jour As String, Mois As String, Rep As String
Dim Fichier As String, Wk As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Do
    LaDate = Application.InputBox(Prompt:="Saisissez une date" & _
        vbCrLf & vbCrLf & _
        "Respectez le format date suivant : Jour/Mois/Ann e", _
        Title:="Choix de la date...", Type:=2)
    'Si l'usager annule...
    If LaDate = False Then MsgBox "Op ration annul e.": Exit Sub
    'si la fen tre se referme vide
    If LaDate = "" Then MsgBox "Op ration annul e.": Exit Sub
    S = Split(LaDate, "/")
    Jour = S(0)
    Mois = S(1)
    Ann e = S(2)
If IsDate(LaDate) Then
    If CDate(LaDate) = DateSerial(Ann e, Mois, Jour) Then
        ok = True
    Else
        MsgBox "probl me avec la date saisie. Recommencer."
    End If
Else
    MsgBox "Le format demand n'a pas t respect . Recommencer."
End If
Loop Until ok = True

'Ce qui s'affichera dans la fen tre
Message = "S lectionner un des r pertoires affich s"
'R pertoire de d part l'ouverture de la fen tre
' toi de le d finir si n cessaire...
Rep = Application.DefaultFilePath
's'assurer que l'on est sur le bon lecteur
ChDrive Left(Rep, 1)
Chemin = ChoixDossier(Rep)
If Chemin = "" Then
    MsgBox "Vous avez annul votre choix. Op ration annul e"
End If

Fichier = Dir(Chemin & "" & "*.xl*")

Do While Fichier <> ""
    Set Wk = Workbooks.Open(Chemin & "" & Fichier)
    With Wk.ActiveSheet.Range("B41")
        If CLng(.Value) <> CLng(CDate(LaDate)) Then
            .NumberFormat = "DD/MM/YY"
            .Value = CLng(CDate(LaDate))
            Wk.Close True
        Else
            Wk.Close
        End If
    End With
    Fichier = Dir()
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'----------------------------------------------------------------------
Function ChoixDossier(Rep As String)
    With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = ActiveWorkbook.Path & ""
      .Show
      If .SelectedItems.Count > 0 Then
         ChoixDossier = .SelectedItems(1)
      Else
         ChoixDossier = ""
      End If
    End With
End Function
'----------------------------------------------------------------------

MichD
---------------------------------------------------------------



merci michD

cela fonctionne au poil

mon seul hic car il en faut un est que mes fichiers ont tous des mots
de passes en ecriture differents.
donc ca merdouille il faut que je les tapes 1 par 1

est ce possible de pouvoir ecrire sans mettre de password?
Avatar
MichD
Si tu as mis des mots de passe pour ouvrir ton fichier, tu n'as pas le choix,
tu dois le fournir à la procédure pour que l'ouverture de ces fichiers
s'effectue normalement.

Tu pourrais dans le classeur où tu as mis cette procédure avoir un tableau sur
une feuille de calcul contenant une colonne contenant la liste des fichiers et
dans une autre colonne, les mots de passe pour chacun d'eux.

En utilisant une approche comme ceci :
x=Application.Match(NomduFichier,PlageNomFichier,0)
MotDePasse = Range("A" & x)

Et dans la ligne qui ouvre le fichier, tu ajoutes le paramètre "PassWord"

Set Wk = Workbooks.Open(Filename:=Chemin & "" & Fichier,PassWord:=MotDePasse)



MichD
---------------------------------------------------------------
Avatar
magic-dd
encore excellent michD

le mot de passe n'est qu'en ecriture donc le systeme de la feuille me
plait bien

j'ai essayé mais cela n'a pas l'air de fonctionner

tres certainement parce que les lignes ne sont pas au bon endroit

merci de ton aide
Avatar
MichD
Dans l'onglet de la Feuil1

Colonne A1:Ax -> Seulement les noms des fichiers + leurs extensions
Colonne B1:Bx -> Mot de passe associé à chaque classeur.

Tu peux modifier le nom de l'onglet dans la procédure
Et si tu veux rendre cette feuille invisible et inaccessible pour les usagers

Worksheets("Feuil1").Visible = xlSheetVeryHidden

Si une feuille n'a pas de mot de passe, il n'est pas traité et tu as un message
qui t'avertit que tel fichier n'a pas de mot de passe...

'---------------------------------------------------------------------------------------------
Sub test()
Dim Chemin As String, Message As String
Dim S As Variant, DerLig As Long, X As Variant
Dim LaDate As Variant, Année As String
Dim Jour As String, Mois As String, Rep As String
Dim Fichier As String, Wk As Workbook
Dim MotDePasse As String

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Do
LaDate = Application.InputBox(Prompt:="Saisissez une date" & _
vbCrLf & vbCrLf & _
"Respectez le format date suivant : Jour/Mois/Année", _
Title:="Choix de la date...", Type:=2)
'Si l'usager annule...
If LaDate = False Then MsgBox "Opération annulée.": Exit Sub
'si la fenêtre se referme vide
If LaDate = "" Then MsgBox "Opération annulée.": Exit Sub
S = Split(LaDate, "/")
Jour = S(0)
Mois = S(1)
Année = S(2)
If IsDate(LaDate) Then
If CDate(LaDate) = DateSerial(Année, Mois, Jour) Then
ok = True
Else
MsgBox "problème avec la date saisie. Recommencer."
End If
Else
MsgBox "Le format demandé n'a pas été respecté. Recommencer."
End If
Loop Until ok = True

'Ce qui s'affichera dans la fenêtre
Message = "Sélectionner un des répertoires affichés"
'Répertoire de départ à l'ouverture de la fenêtre
'à toi de le définir si nécessaire...
Rep = Application.DefaultFilePath
's'assurer que l'on est sur le bon lecteur
ChDrive Left(Rep, 1)
Chemin = ChoixDossier(Rep)
If Chemin = "" Then
MsgBox "Vous avez annulé votre choix. Opération annulée"
End If

Fichier = Dir(Chemin & "" & "*.xl*")

Do While Fichier <> ""
With Worksheets("Feuil1")
DerLig = .Range("A65536").End(xlUp).Row
X = Application.Match(Fichier, .Range("A" & DerLig), 0)
If IsNumeric(X) Then
MotDePasse = .Range("B" & DerLig)
Set Wk = Workbooks.Open(Filename:=Chemin & "" & Fichier,
Password:=MotDePasse)
With Wk.ActiveSheet.Range("B41")
If CLng(.Value) <> CLng(CDate(LaDate)) Then
.NumberFormat = "DD/MM/YY"
.Value = CLng(CDate(LaDate))
Wk.Close True
Else
Wk.Close False
End If
End With
Set Wk = Nothing
Else
Err = 0
MsgBox "Pas trouvé de mot de passe pour le fichier " & _
"""" & Fichier & """."
End If
Fichier = Dir()
End With
Loop

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'----------------------------------------------------------------------
Function ChoixDossier(Rep As String)
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'----------------------------------------------------------------------







MichD
---------------------------------------------------------------
"magic-dd" a écrit dans le message de groupe de discussion :


encore excellent michD

le mot de passe n'est qu'en ecriture donc le systeme de la feuille me
plait bien

j'ai essayé mais cela n'a pas l'air de fonctionner

tres certainement parce que les lignes ne sont pas au bon endroit

merci de ton aide
1 2