Bonjour,
En rentrant un numéro d'affaire sur une feuille Excel, des données venant d'autres classeurs sont insérées.
Le soucis c'est que ces données peuvent être modifiées et que mon classeur ne prend pas en compte ces modifications.
Serait-il possible à l'aide d'une macro d'actualiser les chiffres de ces autres classeurs?
Merci
Le premier paragraphe me fait penser que tu "regrettes" que les données modifiées des "autres" classeurs ne sont pas insérées dans LE classeur.
Le deuxième paragraphe fait penser que tu veux modifier les données des "autres" classeur à l'aide de celles DU classeur.
Quid ? De toutes façons, si les liens entre les classeurs sont des formules au sens d'Excel faisant référence à d'autres classeurs, les mises à jour sont en principe automatiques. S'il y a des macro, il faut voir le problème...
On trouve des chercheurs qui cherchent ; on cherche des chercheurs qui trouvent !
Grâce au code VBA ci-dessous le numéro d'affaires inséré ouvre le classeur souhaité, va chercher les valeurs recherchées puis les inséres dans la case choisit.
Le problème étant le suivant :
-si les valeurs changent après avoir entrée le numéro d'affaire, ces valeurs ne sont pas actualisées.
-il faut alors effacer et réécrire le numéro d'affaire pour retourner lire le tableau et ainsi de suite ...
Je voudrais donc savoir si on peut à l'aide d'une macro permettre un calcul automatique
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculate = calcul
If Not Target.Column = 1 Then Exit Sub ' Ne réagir que si elle est située dans la première colonne
If IsEmpty(Target) Then Exit Sub ' Ne pas lancer la procédure lorsqu'on efface une cellule
If Not IsNumeric(Target) Then Exit Sub ' Ne réagir qu'à la saisie d'un numéro d'affaire
Debug.Print Target
' On dispose donc ici du numéro d'affaire
' Il reste à parcourir le document "Planning Montage.xls" pour trouver les données relatives à cette affaire et à les reporter en face
Dim w, planning As Workbook
For Each w In Application.Workbooks
If w.Name = "Planning Montage.xls" Then Set planning = w
Next w
If planning Is Nothing Then
'Le document n'était pas ouvert, donc il faut l'ouvrir
Application.Workbooks.Open Application.ActiveWorkbook.Pat h & "\" & "Planning Montage.xls"
Set planning = Workbooks("Planning Montage.xls")
End If
Dim planningSheet As Worksheet, r As Range, c As Range, premièreLigne As Integer, dernièreLigne As Integer
Dim semaineDébut As Integer, semaineFin As Integer
Set planningSheet = planning.Sheets("Planning")
Set r = planningSheet.Columns("A:A")
Set c = r.Find(What:=Target.Value, LookIn:=xlValues)
If c Is Nothing Then Exit Sub
' On ne travaille que si on a trouvé le n° d'affaire
' On va rechercher toutes les lignes qui comporte ce numéro d'affaire en colonne 1
premièreLigne = c.Row
Do
TrouverBornes c, semaineDébut, semaineFin
dernièreLigne = c.Row
Set c = r.FindNext(c)
Loop While Not c Is Nothing And c.Row <> premièreLigne
' On dispose maintenant des numéros de colonne dans lesquelles l'affaire commence (semaineDébut)
' et finit (semaineFin). Il reste à aller récupérer les numéros de semaine corresondants
' Ceux-ci se trouvent sur la ligne 1 du planning
semaineDébut = planningSheet.Cells(1, semaineDébut + 1)
semaineFin = planningSheet.Cells(1, semaineFin + 1)
Debug.Print semaineDébut, semaineFin
' Il ne reste plus qu'à les reporter à côté de la cellule dans laquelle on a tapé le numéro d'affaire
Target.Offset(0, 2) = semaineDébut
Target.Offset(0, 3) = semaineFin
' Attention : si on commence en semaine 4 et qu'on finit en semaine 8, il me semble que la durée est de 5 semaines
' et non de 4 comme vous l'avez indiqué dans votre document
' D'où le +1 final
' On ajoute 52 à tout cela pour permettre les calculs de durée avec un début en semaine 51 et la fin en semaine 2 par exemple
Target.Offset(0, 4) = (52 + semaineFin - semaineDébut + 1) Mod 52
Private Sub TrouverBornes(c As Range, ByRef semaineDébut As Integer, ByRef semaineFin As Integer)
Dim sem1 As Integer, sem2 As Integer
Dim i As Integer
i = 10
Do While i < 62
If IsNumeric(c.Offset(0, i)) And c.Offset(0, i) > 0 Then
If semaineDébut = 0 Or i < semaineDébut Then semaineDébut = i
If i > semaineFin Then semaineFin = i
End If
i = i + 1
Loop
End Sub
