1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
Option Explicit
Public MessagePresenceVariables As String, Resultat As String
Sub MettreAJourLeFichier2(ByVal NomFichier1 As String, ByVal NomOnglet2 As String)
Dim I As Long, ColNom As Long, ColDate As Long, ColStatut As Long, LigneTitreCible As Long, DerniereLigneCible As Long
Dim CheminComplet As String, NomFichier2 As String, NomOnglet As String
Dim WbSource As Workbook, WbCible As Workbook
Dim ShCible As Worksheet
Dim AireSource As Range, AireCibleNom As Range, AireCibleDate As Range, AireCibleStatut As Range
Dim Continuer As Boolean
On Error GoTo Fin
Set WbSource = ActiveWorkbook
NomFichier2 = "Fichier2.xlsm"
CheminComplet = ActiveWorkbook.Path & "\" & NomFichier2
If FichierOuvert("Fichier2.xlsm") = False Then Workbooks.Open CheminComplet
Set WbCible = Workbooks(NomFichier2)
' Recherche de l'onglet choisi
Continuer = False
With WbCible
For I = 1 To .Sheets.Count
If .Sheets(I).Name = NomOnglet2 Then
Set ShCible = .Sheets(I)
Continuer = True
Exit For
End If
Next I
If Continuer = False Then
MsgBox "Aucun onglet " & NomOnglet2 & " trouvé !", vbCritical, "Recherche de l'onglet dans " & WbCible.Name
GoTo Fin
End If
End With
With ShCible
LigneTitreCible = 1
MessagePresenceVariables = "Absence colonnes : " & Chr(10)
ColNom = ColonnePosition(ShCible, LigneTitreCible, "Nom")
ColDate = ColonnePosition(ShCible, LigneTitreCible, "Date")
ColStatut = ColonnePosition(ShCible, LigneTitreCible, "Statut")
If MessagePresenceVariables <> "Absence colonnes : " & Chr(10) Then
MsgBox MessagePresenceVariables, vbCritical
GoTo Fin
End If
DerniereLigneCible = .Cells(.Rows.Count, ColNom).End(xlUp).Row
Set AireCibleNom = .Range(.Cells(LigneTitreCible + 1, ColNom), .Cells(DerniereLigneCible, ColNom))
Set AireCibleDate = AireCibleNom.Offset(0, ColDate - ColNom)
Set AireCibleStatut = AireCibleNom.Offset(0, ColStatut - ColNom)
End With
For I = 1 To AireCibleNom.Count
If AireCibleNom(I) = NomFichier1 Then
If AireCibleDate(I) = "" Then
AireCibleDate(I) = Format(Date, "mm/dd/yyyy")
AireCibleStatut(I) = "Traité"
Resultat = "Traité"
Else
Resultat = "Traité le " & AireCibleDate(I)
End If
End If
Next I
If Resultat = "" Then Resultat = NomFichier1 & " non trouvé."
GoTo Fin
Fin:
If FichierOuvert(WbCible) = True Then WbCible.Close savechanges:=True
Set WbSource = Nothing: Set WbCible = Nothing
End Sub
Function FichierOuvert(ByVal NomDuFichier As String) As Boolean
Dim WbEnCours As Workbook
FichierOuvert = False
For Each WbEnCours In Application.Workbooks
If WbEnCours.Name = NomDuFichier Then FichierOuvert = True
Next WbEnCours
End Function
Function ColonnePosition(ByVal FeuilleEnCours As Worksheet, ByVal LigneTitre As Long, ByVal TitreRecherche As String)
Dim CtrI As Long, NbColPosition As Long
Dim AireTitre2 As Range
ColonnePosition = 0
With FeuilleEnCours
NbColPosition = .Cells(LigneTitre, .Columns.Count).End(xlToLeft).Column
Set AireTitre2 = .Range(.Cells(LigneTitre, 1), .Cells(LigneTitre, NbColPosition))
For CtrI = 1 To AireTitre2.Count
Select Case Mid(AireTitre2(CtrI).Value, 1, Len(TitreRecherche))
Case TitreRecherche
ColonnePosition = AireTitre2(CtrI).Column
Exit For
End Select
Next
Set AireTitre2 = Nothing
End With
If ColonnePosition = 0 Then
MessagePresenceVariables = MessagePresenceVariables & TitreRecherche & Chr(10)
End If
End Function |
Comparaison communs a 2 fichiers xlsm et déclenchement double clic
Répondre avec citation
Envoyé par tepuy
.
Partager