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 142 143 144 145 146 147 148 149 150 151 152 153
| Private Sub CommandButton1_Click()
'Sortie de macro si aucune donnée dans la listbox
If ListBox1.ListCount = 0 Then Exit Sub
Dim Un() As String ' tableau vide
Dim Deux() As String
Dim Nb() As Long
Dim sup As String
Dim resultat As String
Dim i As Long ' variables
Dim j As Long
Dim k As Long
Dim l As Long
If Main_menu.ListBox1.ListCount < 0 Then: Exit Sub ' liste vide
ReDim Un(Main_menu.ListBox1.ListCount) ' espece(NbEnregisListe
ReDim Deux(Main_menu.ListBox1.ListCount)
ReDim Nb(Main_menu.ListBox1.ListCount)
For i = 1 To Main_menu.ListBox1.ListCount ' charge Un<-Main_menu.ListBox1
Un(i) = Main_menu.ListBox1.List(i - 1, 0) & " " & Main_menu.ListBox1.List(i - 1, 1) & " " & Main_menu.ListBox1.List(i - 1, 2) & " " & Main_menu.ListBox1.List(i - 1, 3)
Next i
For i = 1 To Main_menu.ListBox1.ListCount ' TEST
k = 0
For j = 1 To Main_menu.ListBox1.ListCount ' compte combien de chaque
If Un(i) <> "" And Un(i) = Main_menu.ListBox1.List(j - 1, 0) & " " & Main_menu.ListBox1.List(j - 1, 1) & " " & Main_menu.ListBox1.List(j - 1, 2) & " " & Main_menu.ListBox1.List(j - 1, 3) Then k = k + 1
Next j
If Un(i) = "" Then
Deux(i) = Un(i) & "" & k ' écrit objet + nombre
Else
Deux(i) = Un(i) & " quantité " & k ' écrit objet + nombre
End If
sup = Un(i) ' suprime objet de la recherche
For l = 1 To Main_menu.ListBox1.ListCount
If sup = Un(l) Then: Un(l) = ""
Next l
Next i
resultat = ""
k = 0
For i = 1 To Main_menu.ListBox1.ListCount ' retasse le 0
If Len(Deux(i)) > 2 Then
resultat = resultat & Deux(i) & Chr(13) & Chr(10)
k = k + 1
End If
Next i
resultat = resultat & "Total des échantillons: " & Main_menu.ListBox1.ListCount '& _
MsgBox resultat
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("C:\temp\Sparepart.log", True)
a.WriteLine (resultat)
a.Close
End Sub
Private Sub Effacer_liste_Click()
ListBox1.Clear
End Sub
Private Sub SCANBOX_AfterUpdate()
'Si valeur inputbox vide alors...
If SCANBOX.Value = "" Then
'Aucune action effectuée dans notre cas
'Si valeur inputbox non vide on lance la procédure de recherche Search()
ElseIf Len(SCANBOX) >= 10 Then
Search
Else
End If
End Sub
Private Sub UserForm_Initialize()
'Nom de l'application
Main_menu.Caption = "MON_APPLICATION"
'Masquage des valeurs par défaut des labels retour d'information suivants
INFORMATION.Caption = ""
REFERENCE_MHP.Caption = ""
DESIGNATION.Caption = ""
CARACTERISTIQUE.Caption = ""
EMPLACEMENT.Caption = ""
'Nombre et largeur de colonne de la ListBox (10 maximum)
ListBox1.ColumnCount = 5
'ListBox1.ColumnWidths = "0;105;95;70;55"
'Focus dans la SCANBOX
SCANBOX.SetFocus
End Sub
Sub Search()
'Delai pour essai
'Application.Wait DateAdd("s", 1, Now)
'Sélection de la feuille de travail
Sheets("FEUIL1").Select
'On détermine la dernière ligne de la colonne A
lastrow = Range("A" & Rows.Count).End(xlUp).Row
'On détermine la plage de recherche
Dim ht As Range
SearchValue = SCANBOX.Value
Set ht = Sheets("FEUIL1").Range("A1:A" & lastrow).Find(SearchValue, LookIn:=xlValues, lookat:=xlWhole)
'Si recherche fructueuse...
If Not ht Is Nothing Then
'MsgBox ht.Address
x = ht.Row
y = ht.Column
'Incrémentation de la quantité à réapprvisionner
INFORMATION.Caption = "Article trouvé ligne " & x
REFERENCE_MHP.Caption = Cells(x, 1).Value
DESIGNATION.Caption = Cells(x, 2).Value
CARACTERISTIQUE.Caption = Cells(x, 3).Value
EMPLACEMENT.Caption = Cells(x, 4).Value
'On alimente la ListBox
ListBox1.AddItem
ListBox1.Column(0, ListBox1.ListCount - 1) = Cells(x, 1)
ListBox1.Column(1, ListBox1.ListCount - 1) = Cells(x, 2)
ListBox1.Column(2, ListBox1.ListCount - 1) = Cells(x, 3)
ListBox1.Column(3, ListBox1.ListCount - 1) = Cells(x, 4)
ListBox1.Column(4, ListBox1.ListCount - 1) = Cells(x, 5)
Set ht = Nothing
'Si recherche non fructueuse...
Else
INFORMATION.Caption = "Article non trouvé"
REFERENCE_MHP.Caption = ""
DESIGNATION.Caption = ""
CARACTERISTIQUE.Caption = ""
EMPLACEMENT.Caption = ""
MsgBox "Référence " & SearchValue & " non trouvée."
End If
'Remise à zéro valeur contenue dans l'inputbox
SCANBOX.Value = ""
SCANBOX.SetFocus
End Sub |
Partager