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
| Option Explicit
Public strPathJob As String
Dim strValue As String
Dim strSingleValue As String
Public boolvalidity As Boolean
Private Sub ButAdd_Click()
strValue = InputBox("Please enter a value to consider to translate the package", "Add filter")
If strValue = "NULL" Or strValue = "" Then
MsgBox "You must enter a not empty value!", vbCritical, "!STOP!"
Exit Sub
Else
'=(1)==================================================================================================================
'vérification que le séparateur ";" existe -------------------------------------------------------------
If InStr(1, strValue, ";") = 0 Then
boolvalidity = False
MsgBox "You forget ; char separator between old value and new value!", vbCritical, "!STOP!"
Exit Sub
Else
boolvalidity = True
End If
'Extraction de la chaine de caractère jusqu'au ";" ---------------------------------------------------
Dim strOldChar As String
Dim intPosition As Integer
intPosition = InStr(1, strValue, ";") - 1
strOldChar = Left(strValue, intPosition)
'=(2)==================================================================================================================
'Vérification que la chaine avant le ";" existe bien dans la feuille Excel "WorkFiles" ----------------
Dim objStringFind
Dim ok As Boolean
'Sheets("Work files").Activate
With Worksheets("Work files").Range("C:C")
Set objStringFind = .Find(strOldChar, LookIn:=xlValues)
If Not objStringFind Is Nothing Then ok = True
Set objStringFind = Nothing
End With
If Not ok Then
MsgBox "Your request value ( " & strOldChar & " ) does not exist in all filename !", vbCritical, "!STOP!"
boolvalidity = False
Exit Sub
Else
boolvalidity = True
End If
'Sheets("Reference File GENERATOR").Activate
'=(3)==================================================================================================================
'Extraction du premier caractère après le ";" ----------------------------------------------------------
Dim strAircraftChar As String
'Dim intPosition As Integer
intPosition = InStr(1, strValue, ";") + 1
strAircraftChar = Mid(strValue, intPosition, 1)
'Vérification que ce caractère est bien une Lettre de l'alphabet ---------------------------------------
Dim intCODE As Integer
intCODE = Asc(strAircraftChar)
If intCODE < 65 Then
Else
'Vérification Programme Avion (AIRBUS) -----------------------------------------------------------------
'strSingleValue = strValue
Call chkPrograms(strAircraftChar)
End If
'Que dois-je faire ? -----------------------------------------------------------------------------------
If boolvalidity = False Then
Exit Sub
Else
End If
'Ajout du filtre si toutes les conditions sont vrai ---------------------------------------------------------
If boolvalidity = True Then
ListBoxFilters.AddItem UCase(strValue)
ButGenerate.Visible = True
Else
MsgBox "For to add a new filter, please you must enter a value corresponding to a part of the old file name then a (;) separator and after a value to change the first value you has entered", vbInformation, "Tips for added a new filter :"
End If
End If
End Sub |
Partager