copies multiples dans classeurs fermés.

[Macpoy]

bonsoir le forum,
avec des macro glanées sur ce forum, j'ai tenté de bricoler (copier/ coller) une macro me permettant de renommer des feuilles dans plusieurs classeurs. mais à un endroit de la boucle je n'arrive pas a nommer le classeur qui doit recevoir la modification.
voici la macro en question :

Sub Chang_date()
Dim Ictr As Integer, NbFichiers As Integer
Dim Zone As String, Tableau() As String
Dim Direction As String, X As String
Dim Uctr As Integer
Dim Nom
Application.ScreenUpdating = False
Direction = Dir(ThisWorkbook.Path & '\\*.xls')

Do While Len(Direction) > 0
If ThisWorkbook.Name <> Direction Then 'pour ne pas prendre en compte le classeur contenant la macro
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
End If

Direction = Dir()
Loop

If NbFichiers > 0 Then

For Uctr = 1 To NbFichiers

=============================================
mon problème se situe sur les 3 prochaines lignes, comment dire à Excel le nom du classeur ?
==============================================

? Sheets(5).Select
? Sheets(5).Unprotect Password:='cocotin'
? Sheets(5).Range('b1') = JSemaine.TextBox1 'format date dans b1
X = Range('b1')
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Select
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr
' Unload Me

ActiveSheet.Next.Select
xd = xd + 2
Next ictr0

Next Uctr
End If
End If
Application.ScreenUpdating = True
Unload JSemaine
Unload QuoiFaire

End Sub

joindre l'ensemble des classeurs ne me semble pas possible.
merci de tout de même tenter quelque chose.
à moins qu'un expert en ado me trouve plus simple ?
d'avance merci.

Macpoy : fait que chaque heure de ta vie, soit un souvenir pour demain.

 

[michel_m]

Bonsoir Macpoy et le forum,


A première vue, je vois mal une solution ADO-ADOX pour ton pb

Car dans cette technologie On considère que chaque feuile excel de ton classeur est une table de données, la base de données étant le classeur.

Apparamment, sous tes 3 lignes les instructions semblent concerner la feuille que tu voudrais renommer ? si oui, je ne crois pas que l'on puisse changer des formats (colorindex, par exemple) et écrire des valeurs comme on le fait sur Excel (comme on est endatabase, on parle en champs range b1 est la valeur de l'enregistrement n)1 dans le 2° champ)

mais le big pb que je rencontre est le mot de passe de ta feuille et je ne trouve pas de propriétés 'password' sur une table:

A mon avis, pour réaliser ton projet, il faudrait que tu ouvres les fichiers de tob répertoire.

J'espère que d'autres réponses me donneront tort (comme ca j'apprendrai qqchose)

A+
Michel

 

[Macpoy]

bonsoir le forum, bonsoir michel_m,
je me suis mal exprimé, mon pb est que lors du déroulement de la macro, Excel ne sait pas à quel classeur appartient la sheets(5) donc par défaut il me renomme les feuilles du classeur ouvert. je souhaites que la boucle permette de faire toutes les actions dans tous les classeurs du fichier.
autrement dit, j'ai un classeur model qui me sert à modifier d'un coup d'un seul plusieurs autres classeurs. mais pour modifier une feuille il faut d'abord dire de quel classeur!!!!
je tente de minimiser ces classeurs pour les joindres, mais c'est pas facil!!!!
merci tout de même d'essayer de comprendre.

 

[Macpoy]

bonsoir le forum,
j'ai enfin trouvé!!!
il ne reste plus qu'a faire une boucle pour sauvegarder et fermer tous les classeurs ouvert par cette macro.
merci à michel_m de s'être penché sur mon usine à gaz.

Const CHem As String = 'D:\\Document de Macpoy\\Classeur d'aide\\Operateurs\\'

Sub Chang_date()
Dim myPath As String
Dim WS As Worksheet
Dim WB As Workbook

stgfilename = Dir(CHem & '\\*.xls')

Do While stgfilename <> ''
Workbooks.Open Filename:=CHem & '\\' & stgfilename
For Each WS In Worksheets
If WS.Name <> 'Interface' Then
WS.Visible = True
End If
Next

Sheets(5).Activate 'Select
Sheets(5).Unprotect Password:='cocotin'
Sheets(5).Range('b1').Value = JSemaine.TextBox1 'format date dans b1
X = JSemaine.TextBox1
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Activate
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr

ActiveSheet.Next.Activate
xd = xd + 2
Next ictr0
stgfilename = Dir()
1 Loop
Unload JSemaine
Unload QuoiFaire

End Sub

vous souhaitant une bonne soirée. @ bientot peut être.

- fait que chaque heure de ta vie soit un souvenir pour demain.

 

[MichelXld]

bonjour MacPoy , bonjoour cher Michel

tu peux tester


Const CHem As String = 'Document de MacpoyClasseur d'aideOperateurs'

Sub Chang_date()
Dim myPath As String
Dim WS As Worksheet
Dim WB As Workbook

stgfilename = Dir(CHem & '*.xls')

Do While stgfilename <> ''
Set WB = Workbooks.Open(Filename:=CHem & '' & stgfilename)
For Each WS In WB.Worksheets
If WS.Name <> 'Interface' Then
WS.Visible = True
End If
Next

Sheets(5).Activate 'Select
Sheets(5).Unprotect Password:='cocotin'
Sheets(5).Range('b1').Value = JSemaine.TextBox1 'format date dans b1
X = JSemaine.TextBox1
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Activate
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr

ActiveSheet.Next.Activate
xd = xd + 2
Next ictr0

WB.Close True 'ferme et sauvegarde les modifications
stgfilename = Dir()
1 Loop
Unload JSemaine
Unload QuoiFaire

End Sub

Message édité par: michelxld, à: 22/07/2005 19:37

 

[Macpoy]

RE le forum, michelxld,
merci pour cette solution,
j'ai mis ceci :

For Each Wb In Workbooks
'cette ligne pour sauvegarder en quittant
If Wb.Name <> 'Classeur Modele pour Operateur.xls' Then Wb.Close SaveChanges:=True
Next

avant le end sub

mais en fait cette usine à gaz n'est pas finie car avant de modifier tous ces classeurs je dois les sauvegarder pour les archiver.
ce qui donne:

Const CHem As String = 'D:\\Document de Macpoy\\Classeur d'aide\\Operateurs\\'
Const Chemin As String = 'D:\\Document de Macpoy\\Classeur d'aide\\Archives Operateurs'


Private Sub Renommer_Click()
Dim Mydate, Myday, Mymonth, Nom As String
Dim myPath As String
Dim WS As Worksheet
Dim Wb
Dim X As String
Mydate = Date
Mymonth = Month(Mydate)
Myyear = Year(Date)
Nom = ActiveWorkbook.Sheets(5).Range('c13').Value
NomFichier = Nom & '-' & Mymonth & ' ' & Myyear & '.xls'

stgfilename = Dir(CHem & '\\*.xls')

MsgBox 'Votre classeur va être enregistré sous' & vbLf & Chemin + Chr(10) + _
NomFichier & vbLf & 'les zones colorées seront éffacées, ' + Chr(10) + _
'les feuilles vont être renommées.', vbOKOnly

Do While stgfilename <> ''
Workbooks.Open Filename:=CHem & '\\' & stgfilename

If JSemaine.TextBox1.Value = '' Then
MsgBox 'Il ny à pas de date !!', vbCritical
'Exit Sub
TextBox1.SetFocus
End If

'enregistrement sous nomfichier
ChDir Chemin
ActiveWorkbook.SaveAs Filename:= _
Chemin & NomFichier & '.xls', _
FileFormat:=xlNormal, Password:='', WriteResPassword:='', _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
stgfilename = Dir()
Loop

Do While stgfilename <> ''
Workbooks.Open Filename:=CHem & '\\' & stgfilename

For Each WS In Worksheets
If WS.Name <> 'Interface' Then
WS.Visible = True
End If
Next


Sheets(5).Activate 'Select
Sheets(5).Unprotect Password:='cocotin'
Sheets(5).Range('b1').Value = JSemaine.TextBox1 'format date dans b1
X = JSemaine.TextBox1
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Activate
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr

ActiveSheet.Next.Activate
xd = xd + 2
Next ictr0
stgfilename = Dir()
1 Loop
Unload JSemaine
Unload QuoiFaire
For Each Wb In Workbooks
'cette ligne pour sauvegarder en quittant
If Wb.Name <> 'Classeur Modele pour Operateur.xls' Then Wb.Close SaveChanges:=True
Next

End Sub

 

[michel_m]

Bonsoir macpoy et Michel,

Ce soir, j'avais un peu honte de t'avoir laissé tomber, mais hier j'étais trop vidé pour pouvoir proposer une solution

Heureusement mon vieux copain Michel Xld est intervenu !

Donc, excuses moi et Merci Michel

Bonne soirée

Michel

 

[Macpoy]

Re le forum, michelxld, michel_m
merci beaucoup aux michel(s) pour leur aide,
pas de soucis michel_m au moins ?
pense à te reposer tout de même.

je vous souhaite une bonne soirée, et encore merci.

Fait que chaque heure de ta vie soit un souvenir pour demain.

 

[MichelXld]

rebonsoir MacPoy , bonsoir Michel

MacPoy , à mon avis il est préférable de refermer chaque classeur avant de passer au suivant pour libérer de la mémoire


sinon pour faire une copie de sauvegarde tu pourrais utiliser


Const CHem As String = 'Document de MacpoyClasseur d'aideOperateurs'
Const Chemin As String = 'Document de MacpoyClasseur d'aideArchives Operateurs'

Sub Chang_date()
Dim myPath As String
Dim WS As Worksheet
Dim WB As Workbook

stgfilename = Dir(CHem & '*.xls')

Do While stgfilename <> ''
Set WB = Workbooks.Open(Filename:=CHem & '' & stgfilename)
For Each WS In WB.Worksheets
If WS.Name <> 'Interface' Then
WS.Visible = True
End If
Next

Sheets(5).Activate 'Select
Sheets(5).Unprotect Password:='cocotin'
Sheets(5).Range('b1').Value = JSemaine.TextBox1 'format date dans b1
X = JSemaine.TextBox1
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Activate
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr

ActiveSheet.Next.Activate
xd = xd + 2
Next ictr0

WB.SaveCopyAs Chemin & '\\\\' & Format(Date, 'd mmmm yyyy') & ' ' & stgfilename
WB.Close True 'ferme et sauvegarde les modifications
stgfilename = Dir()
1 Loop
Unload JSemaine
Unload QuoiFaire

End Sub



bon week end
MichelXld

Message édité par: michelxld, à: 22/07/2005 20:55

Message édité par: michelxld, à: 22/07/2005 20:56

 

[MichelXld]

rebonsoir

bon , il y a toujours un soucis pour lire les Slash dans les messages

WB.SaveCopyAs Chemin & '\\' & Format(Date, 'd mmmm yyyy') & ' ' & stgfilename

bonne soiree
MichelXld

 

[Macpoy]

Re le forum, michelxld
en fait je me suis mal exprimé jeune homme !!!
je décris brievement ce que je veus automatiser:
dans un fichier 'operateur' qui comporte 8 classeurs
- Chaque classeur doit être sauvegardé tel quel, mais dans un fichier différent 'archive operateur'.
- ensuite chaque classeur du fichier 'operateur' doit être modifié
et enregistré dans ce même fichier.

en fait ces classeurs permettent sur quatre semaines de quantifier les différent travaux effectués par les operateurs. donc il faut archiver et changer de date toutes les quatres semaines d'ou sauvegarde et modification!!!
je remet le code qui maintenant fonctionne bien.

-----------------------------------------------------------------------------
mais avant dit moi comment tu fait pour changer la couleur du texte de ton post ?
_______________________________________________________________



Const CHem As String = 'D:\\Document de Macpoy\\Classeur d'aide\\Operateurs\\'
Const Chemin As String = 'D:\\Document de Macpoy\\Classeur d'aide\\Archives Operateurs\\'


Private Sub Renommer_Click()
Dim Mydate, Myday, Mymonth, Nom As String
Dim myPath As String
Dim WS As Worksheet
Dim Wb
Dim X As String
Mydate = Date
Mymonth = Month(Mydate)
Myyear = Year(Date)

stgfilename = Dir(CHem & '\\*.xls')

MsgBox 'Votre classeur va être enregistré sous' & vbLf & Chemin + Chr(10) + _
'les zones colorées seront éffacées, ' + Chr(10) + _
'les feuilles vont être renommées.', vbOKOnly

Do While stgfilename <> ''
Workbooks.Open Filename:=CHem & '\\' & stgfilename
Nom = ActiveWorkbook.Sheets(5).Range('c13').Value
NomFichier = Nom & ' - ' & Mymonth & ' ' & Myyear & '.xls'

If JSemaine.TextBox1.Value = '' Then
MsgBox 'Il ny à pas de date !!', vbCritical
TextBox1.SetFocus
End If

'enregistrement sous nomfichier
ChDir Chemin
ActiveWorkbook.SaveAs Filename:= _
Chemin & NomFichier & '.xls', _
FileFormat:=xlNormal, Password:='', WriteResPassword:='', _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
stgfilename = Dir()
Loop

stgfilename = Dir(CHem & '\\*.xls')

Do While stgfilename <> ''
Workbooks.Open Filename:=CHem & '\\' & stgfilename

For Each WS In Worksheets
If WS.Name <> 'Interface' Then
WS.Visible = True
End If
Next


Sheets(5).Activate 'Select
Sheets(5).Unprotect Password:='cocotin'
Sheets(5).Range('b1').Value = JSemaine.TextBox1 'format date dans b1
X = JSemaine.TextBox1
xd = DateSerial(Val(Right(X, 2)), Val(Mid(X, 4, 2)), Val(Left(X, 2)))
For ictr0 = 1 To 4
For Ictr = 1 To 5
ActiveSheet.Unprotect Password:='cocotin'
Range('t14:t30').Value = 0
Range('c2:c12').Interior.ColorIndex = xlNone 'effacement des couleurs
Range('c2:c12').ClearContents
Range('b1').Value = xd
Xn = Format(xd, 'dddd-dd-mmm')
ActiveSheet.Name = Xn 'format spécial pour nom de feuille
ActiveSheet.Next.Activate
ActiveSheet.Unprotect Password:='cocotin'

xd = xd + 1

Next Ictr

ActiveSheet.Next.Activate
xd = xd + 2
Next ictr0
stgfilename = Dir()
1 Loop
Unload JSemaine
Unload QuoiFaire
For Each Wb In Workbooks
If Wb.Name <> 'Classeur Modele pour Operateur.xls' Then
Wb.Close SaveChanges:=True
End If
Next

End Sub

encore un fois merci pour ton aide, je ne fait pas la modification que tu proposes car j'hesite quant à la finalité par rapport à mon cahier des charges. le ''workbook.savecopy as '' avant le ''loop'' me semble pas cool à cet endroit.

deux mains qui se cherchent, c'est assez pour le toi de demain.