code vba (denismichon)

Bonjour Srogeau,

Ça fait déjà un bon moment que j'ai écrit cette procédure !

A -
De mémoire, dans le fichier que je t'avais transmis, j'avais laissé sur ta feuille "Cheptel" le bouton de commande
"Mettre à jour info". Ce bouton bien qu'il exécute la macro, il ne fait que répéter le travail qui est déjà fait.
Lorsque tu actives ta feuilles "Cheptel" (regarde le code dans le module feuille de ta feuille cheptel) ... la mise à
jour est faite automatiquement sans que tu es à intervenir et sans que tu ais besoin d'utiliser ce bouton.

B - La Variable Flag
Observe dans ton module, la variable Flag est défini dans le haut du module comme Public. Ceci veut dire que sa valeur
peut être modifiée par un autre programme situé ailleurs dans ton projet. Tu peux utiliser la fonction "Recherche" sous
le menu "Édition" de la fenêtre VBE(visual basic editor) et tu peux voir l'endroit où chaque occurrence de la variable
"Flag" se situe. Dans les faits, dans le module de la feuille Cheptel, La variable Flag intervient dans la procédure.

La question : Où est situé le flag qui est en surbrillance ? Lequel ???

C - En principe, il n'y aucun problème à dédoubler la procédure pour pouvoir modifier le nom de la feuille, c'est
sûrement plus facile pour toi que d'apprendre à passer un paramètre à une procédure . Si tes données sont disposées
exactement de la même manière d'une feuille à l'autre... cela devrait fonctionner en modifiant seulement le nom de la
feuille dans la procédure. Pour cette nouvelle feuille, tu devrais choisir à quelle moment tu veux mettre tes données à
jour: en activant la feuille ou par un bouton de commande. Dans les 2 cas, tu peux t'inspirer directement des
procédures déjà existantes dans ton programmes.

Par Activation de ta feuille : Regarde le code de la feuille module Cheptel

Par bouton de commande : la macro miseajour est dans le module du même nom.


Il n'est pas évident de se rappeler un peu plus d'un mois plus tard, les procédures que l'on a écrite ! (pour moi)


Bon travail.


Salutations!








"Srogeau" <srogeau@aol.com> a écrit dans le message de news:20031017110424.19515.00000355@mb-m07.aol.com...
bonjour denis,
le code ci dessous recupere les infos de la colonne"E" feuill histoet me les
envoi
dans la cellule "E19" feuill cheptel
est il possible que je recopie une seconde fois toute ta procedure ci dessous
dans un 2eme module que j'associerai a un autre bouton afin de recuperer de la
meme facon les donnee de la colonne "E" feuill histo;et les envoyer dans la
cellule "F 19" feuill cheptel .J'ai fait l'essai les infos sont recuperes mais
cela me cree un" message d'erreur" (surlignage de Flag) ou ne peut t-on pas
rajouter sur le code le complement pour effectuer les deux operations c'est a
dire faire deja ce qu'il fait +recuperer la colonne "E"feuill histo et envoyer
dans "F"19" feuill cheptel
merci par avance
Sub MettreAJourInfo()

Dim Rg As Range, Rg1 As Range, LaVache As String
Dim Nb As Integer
Flag = True
'Détermine l'étendue de la plage occupée
'sur la feuille Histo.
With Worksheets("Histo")
Set Rg = .Range("A1:P" & .Range("A65536").End(xlUp).Row)
Nb = Application.CountA(.Range("A1:A" & .Range("A65536").End(xlUp).Row))
If Nb <> Rg.Rows.Count Then
Application.EnableEvents = True
Flag = False
MsgBox "Au moins une cellule de la plage " & Rg.Resize(, 1).Address(0,
0) & _
" ne contient pas de données." & vbCrLf & vbCrLf & _
"Mise à jour annulée.", vbCritical + vbOKOnly, "Attention"
Exit Sub
End If
If Worksheets("CHEPTEL").Range("D12") <> "" Then
A = Application.Match(Worksheets("CHEPTEL").Range("D12").Value,
.Range("A1:A" & .Range("A65536").End(xlUp).Row), 0)
If Not IsError(A) Then
LaVache = Worksheets("CHEPTEL").Range("D12")
Else
If Rg(2, 1) = "" Then
Flag = False
Application.EnableEvents = True
Exit Sub
Else
LaVache = Rg(2, 1)
Application.EnableEvents = True
Worksheets("CHEPTEL").Range("D12") = LaVache
Application.EnableEvents = False
End If
End If
Else
If Rg(2, 1) = "" Then
Flag = False
Exit Sub
Else
LaVache = Rg(2, 1)
Application.EnableEvents = True
Worksheets("CHEPTEL").Range("D12") = LaVache
Application.EnableEvents = False
End If
End If
If LaVache = "" Then
Application.EnableEvents = True
Exit Sub
End If
End With

With Worksheets("CHEPTEL")
'Détermine la cellule où sera copiée l'information
'recueillie par le filtre
Set Dest = .Range("E19")
Dest.Resize(Dest.CurrentRegion.Rows.Count).ClearContents
End With

With Rg
'Exécution du filtre
.AutoFilter Field:=1, Criteria1:=LaVache
'Détermination de l'information à copier
'seulement la colonne I:I
Set Rg1 = Rg.Offset(1, 4).Resize(Rg.Rows.Count - 1, Rg.Columns.Count -
15).SpecialCells(xlCellTypeVisible)
Rg1.Copy
Nb = Application.Subtotal(3, Worksheets("Histo").Range("A:A")) - 1
'Copie de l'information vers la destination
Dest.Resize(Nb, 1).PasteSpecial xlValues

Application.CutCopyMode = False
'Enlève le filtre
.AutoFilter
Application.EnableEvents = True
End With

'Libère la mémoire des objets
Set Rg = Nothing: Set Rg1 = Nothing

End Sub