renseigner une date ...

dn35 · 17 Novembre 2009

Bonjour à tous,

De retour pour un tout petit problème 😉
J'ai ce code (récupéré sur un excellent fichier mis en ligne sur ce site)

Code:

Sub archivage()
    Dim x, L1 As Integer
    Dim totarchive As Currency
    Dim N1, N2 As String

Feuil1.Activate
Feuil1.Unprotect "toto"
Range("Début").Offset(1, 0).Select
N1 = ActiveSheet.Name
Feuil4.Activate
Feuil4.Unprotect "toto"
Range("A5").Select
N2 = ActiveSheet.Name
AllerA_LigneVierge
L1 = Selection.Row

Worksheets(N1).Activate
Range("Début").Select
 Selection.AutoFilter Field:=1
 Tri
 
 x = 5
 Do While Worksheets(N1).Cells(x, 1).Value <> ""
If Worksheets(N1).Cells(x, 20).Value <> "" And _
    Worksheets(N1).Cells(x, 21).Value <> "" And _
         Worksheets(N1).Cells(x, 19).Value = "clos" And _
               Worksheets(N1).Cells(x, 2).Value <> "" Then
               
Worksheets(N1).Range(Cells(x, 1), Cells(x, 21)).Copy
Worksheets(N2).Cells(L1, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
Worksheets(N1).Unprotect ("toto")
Worksheets(N1).Range(Cells(x, 2), Cells(x, 23)).ClearContents
Worksheets(N1).Protect ("toto")
Application.CutCopyMode = False
L1 = L1 + 1
End If
x = x + 1
If x > 100 Then MsgBox "beaucoup de DI en attente !!!,vbexclamation"
If x > 3000 Then Exit Do
Loop

Worksheets(N2).Activate
Range("A1").Select
Tri

Worksheets(N1).Activate
Range("Début").Offset(1, 0).Select
Tri

End Sub

celui-ci me permet d'archiver des lignes dites "close" Ce que je souhaite c'est réussir à intégrer ce bout de code :

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 20 Then 
Target.Offset(0, 2) = Date 
End If

End Sub

Que j'utilise sur une autre feuille
Ce que je souhaite c'est pouvoir indiquer la date d'archivage en bout de tableau. Malheureusement je ne sais pas trop a quel moment placer ce code et comment l'adapter efficacement ... Si vous aviez quelques idées ...

Merci d'avance et bon appetit à tous

dn35 · 17 Novembre 2009

Re : renseigner une date ...

petit up .... si quelqu'un a une idée ???

fhoest · 17 Novembre 2009

Re : renseigner une date ...

bonsoir,
je ne sais pas comment ce que fais exacement ton code mais si il n'est pas trop long declare ton petit de code en sub test() puis fais des appels a chaque ligne en analysant avec le debugger pas a pas pour voir exactement ou ton bout de code serais a ton gout le mieux placer
peut etre pas la meilleure des solution mais c'est une solution quand meme
A bientot

Pierrot93 · 18 Novembre 2009

Re : renseigner une date ...

Bonjour dn35, fhoest

le placer sans doute avant la protection, comme suit :

Code:

With Worksheets(N1)
    .Unprotect ("toto")
    .Range(.Cells(x, 2), .Cells(x, 23)).ClearContents
    [B][COLOR="Blue"].Cells(x, 22) = Date[/COLOR][/B]
    .Protect ("toto")
End With

maintenant, sans un bout de fichier, difficile de t'en dire plus...

bonne journée
@+

dn35 · 18 Novembre 2009

Re : renseigner une date ...

Bonjour fhoest, pierrot,

et merci de vos réponses ... mais galère un peu. Je vous dépose le fichier ici pour que vous puissiez visualiser.

Mot de passe de déprotection des feuilles est "toto"
Des données sont entrées dans la feuille "relevé" chaque jour et suivies ( ce sont des demandes d'intervention auprès du personnel de la maintenance). Lorsque les lignes sont cloturées et validées par les deux parties (maintenance et production) elles sont archivées dans la feuille "archives" et supprimées du relevé.
Ce que je souhaite c'est pouvoir indiquer la date d'archivage dans la colonne prévue à cet effet.

Bonne journée
Laure

fhoest · 18 Novembre 2009

Re : renseigner une date ...

BONJOUR
merci pour ton fichier mais il lance un userform avec demande d'accés mot de passe TOTO ne fonctionne pas pour ça et pas moyen de sortir sauf par le gestionnaire de taches
peux tu svp envoyer le MDP de ce userform

fhoest · 18 Novembre 2009

Re : renseigner une date ...

ok c'est bon pour le mdp je suis dans le code

fhoest · 18 Novembre 2009

Re : renseigner une date ...

essai plutot ca
If ActiveWindow.ScrollColumn = 20 Then
ActiveCell.Offset(0, 2) = Date
End If

dn35 · 18 Novembre 2009

Re : renseigner une date ...

Salut floest,

et merci. Désolée oui j'avais oublié le mot de passe d'ouverture ... mais les feuilles étaient accessibles autrement en choisissant l'utilisateur "autres " et sans mettre de mot de passe.

Sinon merci pour le code je l'ai inséré en diférents endroits de mon code sans résultat ..... (Je débute franchement en VBA !) Peux tu me préciser où tu pense qu'il doit être mis ?

Merci bon appetit
Laure

fhoest · 18 Novembre 2009

Re : renseigner une date ...

bonjour
je pense tout simplement ca:
Sub AllerA_LigneVierge() ' aller à la première ligne vierge
Dim u As Integer

u = 5
Do While True
If Cells(u, 2).Value <> "" Then
u = u + 1
Else
Cells(u, 1).Select
Exit Do
End If

Loop
Cells(u, 22) = Date

End Sub

dn35 · 19 Novembre 2009

Re : renseigner une date ...

bonjour,

Merci, oui effectivement cela fonctionne mais cela me met également la date dans la cellule du dessous puisque elle devient la première ligne vierge à la fin de l'opération. Du coup, la valeur se retrouvera erronée lors de l'archivage suivant.

Voici que qui me paraissait le plus logique : (je te remets tous le code d'archivage, la ligne de code est plus bas que ce qu'on visualise)

Code:

'Archiver les travaux validés

Sub archivage()
    Dim x, L1 As Integer
    Dim totarchive As Currency
    Dim N1, N2 As String

'feuille concernée
Feuil1.Activate
'Deprotection de la feuille
Feuil1.Unprotect "toto"
Range("Début").Offset(1, 0).Select
'Nom de la feuille à copier
N1 = ActiveSheet.Name
'Detection de la ligne vide ne fin d'archivage
Feuil4.Activate
'deprotection de la feuille
Feuil4.Unprotect "toto"
Range("A5").Select
'nom de la feuille d'archives
N2 = ActiveSheet.Name
AllerA_LigneVierge
L1 = Selection.Row

If ActiveWindow.ScrollColumn = 20 Then
ActiveCell.Offset(0, 2) = Date
End If

'Feuille relevé
Worksheets(N1).Activate
Range("Début").Select
'On supprime les filtres
 Selection.AutoFilter Field:=1
 'tri des données par ordre chronologique
 Tri
 
 'Determiner la ligne à copier
 x = 5
 Do While Worksheets(N1).Cells(x, 1).Value <> ""
If Worksheets(N1).Cells(x, 20).Value <> "" And _
    Worksheets(N1).Cells(x, 21).Value <> "" And _
         Worksheets(N1).Cells(x, 19).Value = "clos" And _
               Worksheets(N1).Cells(x, 2).Value <> "" Then
               
'copie de la ligne
Worksheets(N1).Range(Cells(x, 1), Cells(x, 21)).Copy
[COLOR="SeaGreen"]'collage de la ligne[/COLOR]
Worksheets(N2).Cells(L1, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
[COLOR="Red"][B]Cells(x, 23) = Date[/B][/COLOR] [COLOR="Green"]'ou Worksheet(N2).Cells(x,23) = Date[/COLOR]
'suppression de la ligne archivée
Worksheets(N1).Unprotect ("toto")
Worksheets(N1).Range(Cells(x, 2), Cells(x, 23)).ClearContents
Worksheets(N1).Protect ("toto")
Application.CutCopyMode = False
'ligne suivante dans l'archivage
L1 = L1 + 1
End If
'ligne suivante dans la feuille relevé
x = x + 1
If x > 100 Then MsgBox "beaucoup de DI en attente !!!,vbexclamation"
If x > 3000 Then Exit Do
Loop

Worksheets(N2).Activate
Range("A1").Select
Tri

Worksheets(N1).Activate
Range("Début").Offset(1, 0).Select
Tri

End Sub

Mias j'ai un bug sur cette ligne dans le premier cas et dans le deuxième la date s'incrémente dans d'autres cellules, plus haut dans le tableau sans logique apparente ... 😕😕😕
Du coup je suis bloquée. C'est très certainement tout bête mais je vois pas ... Une autre idée ?
Bonne journée

fhoest · 19 Novembre 2009

Re : renseigner une date ...

bonjour,
et avec ce code
Sub AllerA_LigneVierge() ' aller à la première ligne vierge
Dim u As Integer

u = 5
Do While True
If Cells(u, 2).Value <> "" Then
u = u + 1
Else
Cells(u, 1).Select
Exit Do
End If

Loop
Cells(u, 22) = Date
cells(u+1,22)=""
end sub
a essayer encore

dn35 · 23 Novembre 2009

Re : renseigner une date ...

Salut Fhoest,

Je n'ai pas encore testé ton code mais il va poser un porblème :
La macro AllerA_LigneVierge est utilisée non seulement dans la feuille d'archive (dans laquelle je veux inscrire la date d'archivage) mais également dans d'autres onglet du classeur (dans lesquels je n'ai aucun besoin d'inscrire la date.
Je suis casse-pied je sais 🙄 mais as-tu une autre idée ?
Bonne journée

Lii · 23 Novembre 2009

Re : renseigner une date ...

Bonjour,

une autre solution avec une colonne de plus et 2 lignes de plus dans la macro(fichier allégé).
On pourrait programmer les formules par macro pour éviter les copies de cellules les contenant.

fhoest · 23 Novembre 2009

Re : renseigner une date ...

bonjour
pourrais tu envoyer ton fichier avec les bout de code chabger + les cellules complété de quelques ligne afin d'effectuer un tri un archivage et analyser ce qui se passe excatement pour remedier au probleme que tu rencontre
A+

renseigner une date ...

dn35

XLDnaute Occasionnel

dn35

XLDnaute Occasionnel

fhoest

XLDnaute Accro

Pierrot93

XLDnaute Barbatruc

dn35

XLDnaute Occasionnel

fhoest

XLDnaute Accro

fhoest

XLDnaute Accro

fhoest

XLDnaute Accro

dn35

XLDnaute Occasionnel

fhoest

XLDnaute Accro

dn35

XLDnaute Occasionnel

fhoest

XLDnaute Accro

dn35

XLDnaute Occasionnel

Lii

XLDnaute Impliqué

Pièces jointes

fhoest

XLDnaute Accro

Discussions similaires

renseigner une date ...

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Accro

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency