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 131 132 133 134 135 136 137 138 139 140 141
|
Sub verifexistnvxope()
Dim i, j, k, j2, i2, nbcol, var2, nb3 As Integer
Dim objFeuille As Worksheet
Dim mess, mess2 As String
Dim nomcol As Integer
Dim Existence_Dossier2 As Variant
Dim leDossier, verifsuivi2006 As String
Dim letbl2(), letbl3(), Fichier2 As String
Application.Workbooks.Open ("\\Icadefs01\clients\A-C\AFL\Suivi opérationnel\Suivi Des Dossiers 2006.xls")
var2 = 0
j = 0
i = 0
j2 = 0
i2 = 0
k = 0
nbcol = 0
nomcol = 0
nb3 = 0
mess = ""
mess2 = ""
verifsuivi2006 = ""
leDossier = ""
i = Application.ActiveWorkbook.Sheets.Count
For j = 1 To i
If Application.ActiveWorkbook.Sheets(j).Name = "Réceptions AP3" Then
k = j
Exit For
End If
Next
If k <> 0 Then
Set objFeuille = ActiveWorkbook.ActiveSheet
Application.ActiveWorkbook.Sheets(k).Activate
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
nbcol = ActiveWorkbook.ActiveSheet.UsedRange.Columns.Count
' For j = 1 To nbcol
'If LCase(ActiveWorkbook.ActiveSheet.UsedRange.Cells(1, j).Value) = "" Then
'End If
' Next
For j = 2 To i
If LCase(Application.ActiveSheet.Cells(j, 33).Value) = "o" Then
ReDim Preserve letbl2(nb3)
letbl2(nb3) = Application.ActiveSheet.Cells(j, 2).Value
mess = mess & " " & letbl2(nb3)
nb3 = nb3 + 1
End If
Next
'MsgBox mess
'MsgBox UBound(letbl2())
End If
If k = 0 Then
MsgBox "le système n'a pas pu trouvé d'onglet nommé 'Réceptions AP3' dans le fichier 'Suivi Des Dossiers 2006.xls" & _
Chr(10) & "La procédure de vérification d'existence de nouvelles opérations n'a pas pu être effectuée", vbExclamation, "Avertissements"
End If
Application.ActiveWorkbook.Close SaveChanges:=False
'------------------------------------------------------------------------
leDossier = ActiveWorkbook.Path
nb3 = 0
If Dir(leDossier & "\" & "suivi_conseil_2006_icade.xls", vbNormal) <> "" Then
Application.Workbooks.Open (leDossier & "\" & "suivi_conseil_2006_icade.xls")
Application.ActiveWorkbook.Sheets("Suivi Dossiers 2006").Activate
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
i2 = UBound(letbl2())
For j2 = 0 To i2
For j = 2 To i
If LCase(ActiveWorkbook.ActiveSheet.Cells(j, 1).Value) = LCase(letbl2(j2)) Then
var2 = var2 + 1
End If
Next
If var2 = 0 Then
ReDim Preserve letbl3(nb3)
letbl3(nb3) = letbl2(j2)
mess2 = mess2 & " " & letbl3(nb3)
nb3 = nb3 + 1
End If
var2 = 0
Next
j2 = UBound(letbl3())
i2 = 0
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count + 1
For j = i To i + UBound(letbl3()) + 1
If j2 >= i2 Then
ActiveWorkbook.ActiveSheet.Cells(j, 1).Value = letbl3(i2)
End If
i2 = i2 + 1
Next
Application.ActiveWorkbook.Close SaveChanges:=True
Else
MsgBox "Le fichier 'suivi_conseil_2006_icade.xls' dans le dossier '" & _
leDossier & "' n'existe pas." & Chr(10) & _
"La procédure de vérification d'existence de nouvelles opérations n'a pas pu être effectuée, si nouvelles opérations il y a...", vbExclamation, "Avertissements"
End If
End Sub |
Partager