Bonjour à tous,
j'ai un grand besoin d'aide pour ce casse tete :
dans un classeur, j'ai une feuille avec un code enregistré au niveau de la feuille (et non d'un module).
ce code commence ainsi :
Public Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim R As Integer
Dim valeur As String
Dim message
Dim fichier As String
Dim nomF As String
Dim Dern As Integer
Dim x As Integer
Dim cible As Variant
......
après quelques opérations, la macro de cette feuille, lance une autre macro (que j'ai mis egalement dans la feuille) via le code "Call tripardate2".
Cette macro tripardate2 s'applique à la feuille d'un autre classeur (feuille qui contient déja des valeurs, que la macro tripardate2 tri et calcul).
Cette macro tripardate2 merdouille au niveau des calculs ci-après car je pense que la macro ne considere pas les references de cellules spécifiées dans les formules comme des references de la feuille (car lancée directement sur la feuille cette marcro tripardate2 fonctione très bien):
'calculer les stocks et délai
.Range("A4") = Evaluate("sum(D6
65536)-sum(E6:E65536)")
.Range("B4") = Evaluate("A4+sum(F6:F65536)-sum(G6:G65536)")
'calculer le stock prévisionnel pour chaque ligne
For L = 6 To Fin
.Range("H" & L) = Evaluate("(sum(D6" & L & ")-sum(E6:E" & L & "))+(sum(F6:F" & L & ") -sum(G6:G" & L & "))")
Next L
Voila, je ne sais pas si cela est clair.
Je pense que la solution passe par un "private" quelque chose afin que la macro s'effectue avec les données de la feuille, mais je n'arrive pas à trouver.
Je met le code en entier si cela peut aider à la comprehension:
__________________________________________________________
Option Explicit
Public Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim R As Integer
Dim valeur As String
Dim message
Dim fichier As String
Dim nomF As String
Dim Dern As Integer
Dim x As Integer
Dim cible As Variant
fichier = "1 gascogne.xls"
nomF = ActiveWorkbook.Name
R = ActiveCell.Row
'recuperer le nom de la feuille article
valeur = ActiveCell.Value
Dern = ActiveSheet.Range("a1").End(xlDown).Row + 1
cible = Cells(R, 8).Value
If valeur = "ok" Then GoTo line1 Else GoTo line3
line1:
'si erreur afficher "fiche introuvable"
On Error GoTo line5
Windows(fichier).Activate
Sheets(cible).Activate
On Error GoTo 0
'deverouiller les lignes de la feuille suivi et determiner la derniere ligne vide
Windows(nomF).Activate
Sheets("SUIVI").Unprotect
Rows(Dern & ":65535").Locked = False
ActiveSheet.Unprotect
'selectionner les valeurs de la feuille suivi à copier de la feuille article
Windows(nomF).Activate
Range("A" & R, "G" & R).Select
Selection.Copy
'afficher la feuille article trouvée et se positionner sur la premiere ligne vide
Windows(fichier).Activate
Sheets(cible).Activate
x = Worksheets(cible).Range("a1").End(xlDown).Row + 1
Worksheets(cible).Range("A" & x).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'afficher le message de validation de copie
message = MsgBox("Valider la copie ?", vbYesNo + vbDefaultButton1, "Données copiées")
If message = vbYes Then GoTo line2
If message = vbNo Then GoTo line4
line2:
Windows(fichier).Activate
Sheets(cible).Activate
'effectuer la macro tripardate
Call TriparDate2
'revenir à la feuille suivi et incrire la date de copie sur la ligne corespondant, la griser et la verouiller
Windows(nomF).Activate
Range("I" & R) = Evaluate("=NOW()")
Range("A" & R, "I" & R).Select
Selection.Interior.ColorIndex = 15
Selection.Locked = True
Range("A" & R + 1).Select
'ActiveSheet.Protect
GoTo line3
line4:
'effacer les données copiées dans la feuille article
Windows(fichier).Activate
Sheets(cible).Activate
x = Worksheets(cible).Range("a1").End(xlDown).Row
Worksheets(cible).Range("A" & x, "G" & x).ClearContents
'afficher la feuille "récap" permettant de choisir une autre fiche
Windows(fichier).Activate
Sheets("Récap").Activate
GoTo line3
line5:
Windows(nomF).Activate
Range("H" & R).Select
message = MsgBox("Vérifiez la réf. de feuille" & Chr(13) & "Ou créez la feuille article et recommencez", , "Fiche introuvable")
line3:
End Sub
___________________________________________________________
Sub TriparDate2()
Dim L As Long, Fin As Long, article As String
article = ActiveSheet.Name
'deproteger la feuille, deverouiller les lignes, effacer les colonnes de stock prév et . et statistiques
With Sheets(article)
.Unprotect
.Rows("6:65536").Locked = False
.[H6:M65536].ClearContents
'récuperer le n° de la premiere ligne vide
Fin = .[A65536].End(xlUp).Row
'ajouter un . en I si entrée ou sortie réelle et verouiller la ligne
For L = 6 To Fin
If .Range("D" & L) > 0 Or .Range("E" & L) > 0 Then
.Range("I" & L) = "."
.Rows(L).Locked = True
End If
Next L
'trier par date
.Range("A6:I65536").Select
Selection.Sort Key1:=.Range("I6"), Order1:=xlAscending, Key2:=.Range("B6") _
, Order2:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'calculer les stocks et délai
.Range("A4") = Evaluate("sum(D665536)-sum(E6:E65536)")
.Range("B4") = Evaluate("A4+sum(F6:F65536)-sum(G6:G65536)")
'calculer le stock prévisionnel pour chaque ligne
For L = 6 To Fin
.Range("H" & L) = Evaluate("(sum(D6" & L & ")-sum(E6:E" & L & "))+(sum(F6:F" & L & ") -sum(G6:G" & L & "))")
Next L
'se positionner sur la dernière cellule vide en A
.Range("A" & Fin + 1).Select
.Protect
End With
End Sub
j'ai un grand besoin d'aide pour ce casse tete :
dans un classeur, j'ai une feuille avec un code enregistré au niveau de la feuille (et non d'un module).
ce code commence ainsi :
Public Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim R As Integer
Dim valeur As String
Dim message
Dim fichier As String
Dim nomF As String
Dim Dern As Integer
Dim x As Integer
Dim cible As Variant
......
après quelques opérations, la macro de cette feuille, lance une autre macro (que j'ai mis egalement dans la feuille) via le code "Call tripardate2".
Cette macro tripardate2 s'applique à la feuille d'un autre classeur (feuille qui contient déja des valeurs, que la macro tripardate2 tri et calcul).
Cette macro tripardate2 merdouille au niveau des calculs ci-après car je pense que la macro ne considere pas les references de cellules spécifiées dans les formules comme des references de la feuille (car lancée directement sur la feuille cette marcro tripardate2 fonctione très bien):
'calculer les stocks et délai
.Range("A4") = Evaluate("sum(D6
65536)-sum(E6:E65536)").Range("B4") = Evaluate("A4+sum(F6:F65536)-sum(G6:G65536)")
'calculer le stock prévisionnel pour chaque ligne
For L = 6 To Fin
.Range("H" & L) = Evaluate("(sum(D6
" & L & ")-sum(E6:E" & L & "))+(sum(F6:F" & L & ") -sum(G6:G" & L & "))")Next L
Voila, je ne sais pas si cela est clair.
Je pense que la solution passe par un "private" quelque chose afin que la macro s'effectue avec les données de la feuille, mais je n'arrive pas à trouver.
Je met le code en entier si cela peut aider à la comprehension:
__________________________________________________________
Option Explicit
Public Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim R As Integer
Dim valeur As String
Dim message
Dim fichier As String
Dim nomF As String
Dim Dern As Integer
Dim x As Integer
Dim cible As Variant
fichier = "1 gascogne.xls"
nomF = ActiveWorkbook.Name
R = ActiveCell.Row
'recuperer le nom de la feuille article
valeur = ActiveCell.Value
Dern = ActiveSheet.Range("a1").End(xlDown).Row + 1
cible = Cells(R, 8).Value
If valeur = "ok" Then GoTo line1 Else GoTo line3
line1:
'si erreur afficher "fiche introuvable"
On Error GoTo line5
Windows(fichier).Activate
Sheets(cible).Activate
On Error GoTo 0
'deverouiller les lignes de la feuille suivi et determiner la derniere ligne vide
Windows(nomF).Activate
Sheets("SUIVI").Unprotect
Rows(Dern & ":65535").Locked = False
ActiveSheet.Unprotect
'selectionner les valeurs de la feuille suivi à copier de la feuille article
Windows(nomF).Activate
Range("A" & R, "G" & R).Select
Selection.Copy
'afficher la feuille article trouvée et se positionner sur la premiere ligne vide
Windows(fichier).Activate
Sheets(cible).Activate
x = Worksheets(cible).Range("a1").End(xlDown).Row + 1
Worksheets(cible).Range("A" & x).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'afficher le message de validation de copie
message = MsgBox("Valider la copie ?", vbYesNo + vbDefaultButton1, "Données copiées")
If message = vbYes Then GoTo line2
If message = vbNo Then GoTo line4
line2:
Windows(fichier).Activate
Sheets(cible).Activate
'effectuer la macro tripardate
Call TriparDate2
'revenir à la feuille suivi et incrire la date de copie sur la ligne corespondant, la griser et la verouiller
Windows(nomF).Activate
Range("I" & R) = Evaluate("=NOW()")
Range("A" & R, "I" & R).Select
Selection.Interior.ColorIndex = 15
Selection.Locked = True
Range("A" & R + 1).Select
'ActiveSheet.Protect
GoTo line3
line4:
'effacer les données copiées dans la feuille article
Windows(fichier).Activate
Sheets(cible).Activate
x = Worksheets(cible).Range("a1").End(xlDown).Row
Worksheets(cible).Range("A" & x, "G" & x).ClearContents
'afficher la feuille "récap" permettant de choisir une autre fiche
Windows(fichier).Activate
Sheets("Récap").Activate
GoTo line3
line5:
Windows(nomF).Activate
Range("H" & R).Select
message = MsgBox("Vérifiez la réf. de feuille" & Chr(13) & "Ou créez la feuille article et recommencez", , "Fiche introuvable")
line3:
End Sub
___________________________________________________________
Sub TriparDate2()
Dim L As Long, Fin As Long, article As String
article = ActiveSheet.Name
'deproteger la feuille, deverouiller les lignes, effacer les colonnes de stock prév et . et statistiques
With Sheets(article)
.Unprotect
.Rows("6:65536").Locked = False
.[H6:M65536].ClearContents
'récuperer le n° de la premiere ligne vide
Fin = .[A65536].End(xlUp).Row
'ajouter un . en I si entrée ou sortie réelle et verouiller la ligne
For L = 6 To Fin
If .Range("D" & L) > 0 Or .Range("E" & L) > 0 Then
.Range("I" & L) = "."
.Rows(L).Locked = True
End If
Next L
'trier par date
.Range("A6:I65536").Select
Selection.Sort Key1:=.Range("I6"), Order1:=xlAscending, Key2:=.Range("B6") _
, Order2:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'calculer les stocks et délai
.Range("A4") = Evaluate("sum(D6
65536)-sum(E6:E65536)").Range("B4") = Evaluate("A4+sum(F6:F65536)-sum(G6:G65536)")
'calculer le stock prévisionnel pour chaque ligne
For L = 6 To Fin
.Range("H" & L) = Evaluate("(sum(D6
" & L & ")-sum(E6:E" & L & "))+(sum(F6:F" & L & ") -sum(G6:G" & L & "))")Next L
'se positionner sur la dernière cellule vide en A
.Range("A" & Fin + 1).Select
.Protect
End With
End Sub
