API tools faq
paste
Guest User

Untitled

a guest
May 27th, 2018
91
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 32.24 KB | None | 0 0
raw download clone embed print report
  1. Option Base 1
  2. Dim cellier(10, 4, 5) As Vin 'Arg1: Numéro du cellier, Arg2: Casier du cellier, Arg3: Page du cellier
  3. Dim sheetData As Worksheet 'Stock la feuille "data"
  4. Dim sheetCarac As Worksheet 'Stock la feuille "data"
  5. Dim sheetCellier As Worksheet 'Stock la feuille "data"
  6. Dim sheetCepage As Worksheet 'Stock la feuille "data"
  7. Dim sheetFormat As Worksheet 'Stock la feuille "data"
  8. Dim selection(2) 'Stock la feuille "data"
  9. Dim estSelection As Boolean
  10. Dim page As Byte 'Stock la feuille "data"
  11. Dim nbTotVin As Integer 'Stock la feuille "data"
  12.  
  13. Private Sub imgVin_Click()
  14. Dim path As String
  15.  
  16. With Application.FileDialog(msoFileDialogOpen)
  17. .Show
  18. If .SelectedItems.Count = 1 Then
  19. path = .SelectedItems(1)
  20. End If
  21. End With
  22.  
  23. imgVin.Picture = LoadPicture(path)
  24. UserForm1.Repaint
  25.  
  26. End Sub
  27.  
  28. Private Sub sbQuantite_Change()
  29. txfQuantite.Text = sbQuantite.Value
  30. End Sub
  31.  
  32. Public Sub UserForm_Initialize()
  33. 'Ceci charge les vins dans le tableau dans l'array currentCasier. çe n'est pas final mais c'est fonctionel dans
  34. 'une certaine mesure
  35. Set sheetData = Worksheets("data")
  36. Set sheetCarac = Worksheets("caractéristiques")
  37. Set sheetCellier = Worksheets("cellier")
  38. Set sheetCepage = Worksheets("cépage")
  39. Set sheetFormat = Worksheets("format")
  40. page = 1
  41. nbTotVin = sheetData.Cells(2, 2).Value
  42.  
  43. imgVin.Picture = LoadPicture(ThisWorkbook.path & "\Images\VinBase.jpg")
  44. UserForm1.Repaint
  45.  
  46. Dim i As Integer: i = 2
  47. While (i <= nbTotVin + 1)
  48. Dim v1 As Integer: v1 = sheetCellier.Cells(16, i).Value
  49. Dim v2 As Integer: v2 = sheetCellier.Cells(17, i).Value
  50. Dim v3 As Integer: v3 = sheetCellier.Cells(18, i).Value
  51. Set cellier(v1, v2, v3) = New Vin
  52. cellier(v1, v2, v3).couleur = sheetCellier.Cells(1, i).Value
  53. If (cellier(v1, v2, v3).couleur = "r" Or cellier(v1, v2, v3).couleur = "b") Then
  54. cellier(v1, v2, v3).cepage = sheetCellier.Cells(2, i).Value
  55. End If
  56. cellier(v1, v2, v3).nom = sheetCellier.Cells(3, i).Value
  57. cellier(v1, v2, v3).region = sheetCellier.Cells(4, i).Value
  58. cellier(v1, v2, v3).annee = sheetCellier.Cells(5, i).Value
  59. cellier(v1, v2, v3).prix = sheetCellier.Cells(6, i).Value
  60. cellier(v1, v2, v3).quantite = sheetCellier.Cells(7, i).Value
  61. cellier(v1, v2, v3).carVisu = sheetCellier.Cells(9, i).Value
  62. cellier(v1, v2, v3).carOlfa = sheetCellier.Cells(10, i).Value
  63. cellier(v1, v2, v3).carGusta = sheetCellier.Cells(11, i).Value
  64.  
  65. If (v1 <= 5) Then
  66. cellier(v1, v2, v3).casier = v1 & "H" & v2 & "P" & page
  67. Else
  68. cellier(v1, v2, v3).casier = v1 & "B" & v2 & "P" & page
  69. End If
  70. 'MsgBox cellier(v1, v2, v3).nom
  71. i = i + 1
  72. Wend
  73.  
  74. 'Ajoute les items au ComboBox Visuel
  75. For i = 3 To sheetCarac.Cells(1, 2).Value + 2
  76. cmbVisuCar.AddItem (sheetCarac.Cells(i, 1).Value)
  77. cmbVisuelle.AddItem (sheetCarac.Cells(i, 1).Value)
  78. Next
  79. 'Ajoute les items au ComboBox Olfactif
  80. For i = 3 To sheetCarac.Cells(1, 5).Value + 2
  81. cmbOlfaCar.AddItem (sheetCarac.Cells(i, 4).Value)
  82. cmbOlfactive.AddItem (sheetCarac.Cells(i, 4).Value)
  83. Next
  84. 'Ajoute les items au ComboBox Gustatif
  85. For i = 3 To sheetCarac.Cells(1, 8).Value + 2
  86. cmbGustaCar.AddItem (sheetCarac.Cells(i, 7).Value)
  87. cmbGustative.AddItem (sheetCarac.Cells(i, 7).Value)
  88. Next
  89. 'Ajoute les items au ComboBox Format
  90. For i = 2 To 8
  91. cmbFormat.AddItem (sheetFormat.Cells(i, 1).Value)
  92. Next
  93. 'Ajoute les items au ComboBox Pastilles
  94. For i = 2 To 10
  95. cmbPastille.AddItem (sheetFormat.Cells(i, 3).Value)
  96. Next
  97. End Sub
  98.  
  99. Private Sub btnEnregistrer_Click() 'Enregistre dans l'array 3D le vin crée et ses informations.
  100. Dim temp As Double
  101. Dim ctrl As MSForms.Control
  102. Dim toggle As Boolean
  103.  
  104. For Each ctrl In Me.Controls
  105. If TypeName(ctrl) = "OptionButton" Then
  106. If (ctrl.Value = True) And (ctrl.GroupName = "grpAjouter") Then
  107. Set cellier(selection(1), selection(2), page) = New Vin
  108. cellier(selection(1), selection(2), page).couleur = ctrl.Caption
  109. End If
  110. End If
  111. Next
  112.  
  113. If (estSelection = False) Then 'Verifie si casier est select
  114. MsgBox "Veuillez sélectionner un casier d'un cellier."
  115. Exit Sub
  116. ElseIf (cellier(selection(1), selection(2), page).couleur = "") Then 'verifie si couleur select
  117. MsgBox "Vous devez choisir un type d'alcool."
  118. Exit Sub
  119. ElseIf (cellier(selection(1), selection(2), page) Is Nothing) Then 'verifie si la pos dans l'array est vide
  120. Set cellier(selection(1), selection(2), page) = New Vin
  121. ElseIf (txfNom.Value = "") Then 'verifie si txfNom est vide
  122. MsgBox "Veuillez entrer un nom dans le champ approprié."
  123. Exit Sub
  124. ElseIf (txfRegion.Value = "" And obRose2 = False And obAutre2 = False) Then 'verifie si txfRegion est vide
  125. MsgBox "Veuillez entrer une région dans le champ approprié"
  126. Exit Sub
  127. ElseIf (txfAnnee.Value = "") Then 'verifie si txfAnnee est vide
  128. MsgBox "Veuillez entrer une année dans le champ approprié."
  129. Exit Sub
  130. ElseIf (Not IsNumeric(txfPrix.Value) Or txfPrix.Value = "") Then 'verifie si txfPrix est vide et numerique
  131. MsgBox "Veuillez entrer un prix valide (xx.xx)."
  132. Exit Sub
  133. ElseIf (cmbFormat.Value = "") Then 'verifie si cmbFormat est vide
  134. MsgBox "Veuillez entrer un format dans le champ approprié."
  135. Exit Sub
  136. ElseIf ((obRouge2 = True Or obBlanc2 = True) And cmbCepage.Value = "") Then 'verifie si cmbCepage est vide si vin select est rouge ou blanc
  137. MsgBox "Vous devez choisir un cépage pour tout vins rouges ou blancs."
  138. Exit Sub
  139. Else
  140. Do While cmbCepage.ListCount > 0
  141. cmbCepage.RemoveItem (0)
  142. Loop
  143. End If
  144.  
  145. If (cmbVisuelle.Value = "") Then 'verifie si cmbVisuelle est vide
  146. MsgBox "Vous devez entrez une caractéristique visuelle."
  147. Exit Sub
  148. ElseIf (cmbOlfactive.Value = "" And obAutre2 = False) Then 'verifie si cmbOlfactive est vide
  149. MsgBox "Vous devez entrez une caractéristique olfactive."
  150. Exit Sub
  151. ElseIf (cmbGustative.Value = "" And obAutre2 = False) Then 'verifie si cmbGustative est vide
  152. MsgBox "Vous devez entrez une caractéristique gustative."
  153. Exit Sub
  154. ElseIf ((cellier(selection(1), selection(2), page).quantite + CInt(txfQuantite.Value)) > 30) Then 'verifie si qte surpasse 30
  155. MsgBox "Vous ne pouvez pas ajouter " & txfQuantite.Value & " vins, car un casier ne peut dépasser 30 vins total."
  156. Exit Sub
  157. ElseIf (Not IsNumeric(txfPourAlc) Or txfPourAlc.Value = "" Or txfPourAlc.Value > 100 Or txfPourAlc.Value < 0) Then
  158. MsgBox "Vous devez entrer un pourcentage d'alcool entre 0 et 100"
  159. Exit Sub
  160. Else
  161.  
  162. 'couleur déjà set plus haut
  163. cellier(selection(1), selection(2), page).nom = txfNom.Value
  164. cellier(selection(1), selection(2), page).region = txfRegion.Value
  165. cellier(selection(1), selection(2), page).annee = txfAnnee.Value
  166. cellier(selection(1), selection(2), page).prix = txfPrix.Value
  167. cellier(selection(1), selection(2), page).format = cmbFormat.Value
  168. cellier(selection(1), selection(2), page).quantite = txfQuantite.Value
  169. cellier(selection(1), selection(2), page).cepage = cmbCepage.Value
  170. cellier(selection(1), selection(2), page).carVisu = cmbVisuelle.Value
  171. cellier(selection(1), selection(2), page).carOlfa = cmbOlfactive.Value
  172. cellier(selection(1), selection(2), page).carGusta = cmbGustative.Value
  173. cellier(selection(1), selection(2), page).pastille = cmbPastille.Value
  174. cellier(selection(1), selection(2), page).pourAlc = txfPourAlc.Value
  175. cellier(selection(1), selection(2), page).cellierPos = selection(1)
  176. cellier(selection(1), selection(2), page).casierPos = selection(2)
  177. cellier(selection(1), selection(2), page).pagePos = page
  178. End If
  179.  
  180. cellierDefaut
  181.  
  182. End Sub
  183.  
  184. Private Sub btnEnregistrerQuitter_Click()
  185. Dim tempPage As Integer
  186. Dim tempCasier As Integer
  187. Dim tempCellier As Integer
  188. Dim i As Integer: i = 2
  189.  
  190. For tempPage = 1 To UBound(cellier, 3) - 1
  191. For tempCellier = 1 To UBound(cellier, 1) - 1
  192. For tempCasier = 1 To UBound(cellier, 2) - 1
  193. If (cellier(tempCellier, tempCasier, tempPage) Is Nothing) Then
  194. Set cellier(tempCellier, tempCasier, tempPage) = New Vin
  195. End If
  196.  
  197. If (Not cellier(tempCellier, tempCasier, tempPage).quantite = "0") Then
  198. sheetCellier.Cells(1, i) = cellier(tempCellier, tempCasier, tempPage).couleur
  199. sheetCellier.Cells(2, i) = cellier(tempCellier, tempCasier, tempPage).cepage
  200. sheetCellier.Cells(3, i) = cellier(tempCellier, tempCasier, tempPage).nom
  201. sheetCellier.Cells(4, i) = cellier(tempCellier, tempCasier, tempPage).region
  202. sheetCellier.Cells(5, i) = cellier(tempCellier, tempCasier, tempPage).annee
  203. sheetCellier.Cells(6, i) = cellier(tempCellier, tempCasier, tempPage).prix
  204. sheetCellier.Cells(7, i) = cellier(tempCellier, tempCasier, tempPage).quantite
  205. sheetCellier.Cells(9, i) = cellier(tempCellier, tempCasier, tempPage).carVisu
  206. sheetCellier.Cells(10, i) = cellier(tempCellier, tempCasier, tempPage).carOlfa
  207. sheetCellier.Cells(11, i) = cellier(tempCellier, tempCasier, tempPage).carGusta
  208. sheetCellier.Cells(12, i) = cellier(tempCellier, tempCasier, tempPage).pourAlc 'pourcentage alcool
  209. sheetCellier.Cells(13, i) = cellier(tempCellier, tempCasier, tempPage).nom 'Etiquette
  210. sheetCellier.Cells(14, i) = cellier(tempCellier, tempCasier, tempPage).pastille 'pastille
  211. sheetCellier.Cells(15, i) = cellier(tempCellier, tempCasier, tempPage).format 'format
  212. sheetCellier.Cells(16, i) = cellier(tempCellier, tempCasier, tempPage).cellierPos 'pos cellier
  213. sheetCellier.Cells(17, i) = cellier(tempCellier, tempCasier, tempPage).casierPos 'pos casier
  214. sheetCellier.Cells(18, i) = cellier(tempCellier, tempCasier, tempPage).pagePos 'pos page
  215.  
  216. i = i + 1
  217. sheetData.Cells(2, 2).Value = sheetData.Cells(2, 2).Value + 1
  218. End If
  219. Next
  220. Next
  221. Next
  222.  
  223. End Sub
  224.  
  225. Private Sub btnGauche_Click() 'Gère le clique sur le bouton de gauche, voir la méthode associée plus bas
  226. actualiserLabels ("btnGauche")
  227. End Sub
  228.  
  229. Private Sub btnDroite_Click() 'Gère le clique sur le bouton de droite, voir la méthode associée plus bas
  230. actualiserLabels ("btnDroite")
  231. End Sub
  232.  
  233. Sub actualiserLabels(interrupteur As String) 'Actualise les labels et change le page du cellier
  234. If (interrupteur = "btnGauche") Then
  235. btnDroite.Enabled = True
  236. page = page - 1
  237. lblCellier1.Caption = CInt(lblCellier1.Caption) - 5
  238. lblCellier2.Caption = CInt(lblCellier2.Caption) - 5
  239. lblCellier3.Caption = CInt(lblCellier3.Caption) - 5
  240. lblCellier4.Caption = CInt(lblCellier4.Caption) - 5
  241. lblCellier5.Caption = CInt(lblCellier5.Caption) - 5
  242.  
  243. If (page = 1) Then
  244. btnGauche.Enabled = False
  245. End If
  246. ElseIf (interrupteur = "btnDroite") Then
  247. btnGauche.Enabled = True
  248. page = page + 1
  249. lblCellier1.Caption = CInt(lblCellier1.Caption) + 5
  250. lblCellier2.Caption = CInt(lblCellier2.Caption) + 5
  251. lblCellier3.Caption = CInt(lblCellier3.Caption) + 5
  252. lblCellier4.Caption = CInt(lblCellier4.Caption) + 5
  253. lblCellier5.Caption = CInt(lblCellier5.Caption) + 5
  254.  
  255. If (page = 5) Then
  256. btnDroite.Enabled = False
  257. End If
  258. End If
  259. End Sub
  260.  
  261. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  262. '@@ Gère le ListBox pour voir l'inventaire des vins @@
  263. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  264.  
  265. Private Sub obRouge_Click() 'Affiche les vins rouges dans le lsbInventaire
  266. lsbInventaire.Clear
  267. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  268. For i = LBound(cellier, 1) To UBound(cellier, 1)
  269. For j = LBound(cellier, 2) To UBound(cellier, 2)
  270. If nbTotVin > (((i - 1) * 4) + j) Then
  271. If (Not IsNull(cellier(i, j, 1)) And cellier(i, j, 1).couleur = "rouge") Then
  272. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  273. End If
  274. End If
  275. Next
  276. Next
  277. End Sub
  278.  
  279. Private Sub obBlanc_Click() 'Affiche les vins blancs dans le lsbInventaire
  280. lsbInventaire.Clear
  281. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  282. For i = LBound(cellier, 1) To UBound(cellier, 1)
  283. For j = LBound(cellier, 2) To UBound(cellier, 2)
  284. If nbTotVin > (((i - 1) * 4) + j) Then
  285. If (Not IsNull(cellier(i, j, 1)) And cellier(i, j, 1).couleur = "blanc") Then
  286. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  287. End If
  288. End If
  289. Next
  290. Next
  291. End Sub
  292.  
  293. Private Sub obRose_Click() 'Affiche les vins rosés dans le lsbInventaire
  294. lsbInventaire.Clear
  295. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  296. For i = LBound(cellier, 1) To UBound(cellier, 1)
  297. For j = LBound(cellier, 2) To UBound(cellier, 2)
  298. If nbTotVin > (((i - 1) * 4) + j) Then
  299. If (Not IsNull(cellier(i, j, 1)) And cellier(i, j, 1).couleur = "rose") Then
  300. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  301. End If
  302. End If
  303. Next
  304. Next
  305. End Sub
  306.  
  307. Private Sub obPorto_Click() 'Affiche les portos dans le lsbvInventaire
  308. lsbInventaire.Clear
  309. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  310. For i = LBound(cellier, 1) To UBound(cellier, 1)
  311. For j = LBound(cellier, 2) To UBound(cellier, 2)
  312. If nbTotVin > (((i - 1) * 4) + j) Then
  313. If (Not IsNull(cellier(i, j, 1)) And cellier(i, j, 1).couleur = "porto") Then
  314. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  315. End If
  316. End If
  317. Next
  318. Next
  319. End Sub
  320.  
  321. Private Sub obAutre_Click() 'Affiche les autres alchools dans le lsbInventaire
  322. lsbInventaire.Clear
  323. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  324. For i = LBound(cellier, 1) To UBound(cellier, 1)
  325. For j = LBound(cellier, 2) To UBound(cellier, 2)
  326. If nbTotVin > (((i - 1) * 4) + j) Then
  327. If (Not IsNull(cellier(i, j, 1)) And cellier(i, j, 1).couleur = "autre") Then
  328. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  329. End If
  330. End If
  331. Next
  332. Next
  333. End Sub
  334.  
  335. Private Sub obTout_Click() 'Affiche tous les alchools dans le lvbInventaure
  336. lsbInventaire.Clear
  337. lsbInventaire.AddItem ("Casier" & vbTab & "Nom" & vbTab & "Couleur" & vbTab & "Region" & vbTab & "Année" & vbTab & "Prix" & vbTab & "Quantité")
  338. For i = LBound(cellier, 1) To UBound(cellier, 1)
  339. For j = LBound(cellier, 2) To UBound(cellier, 2)
  340. If nbTotVin > (((i - 1) * 4) + j) Then
  341. If (Not IsNull(cellier(i, j, 1))) Then
  342. lsbInventaire.AddItem (cellier(i, j, 1).casier & vbTab & cellier(i, j, 1).nom & vbTab & cellier(i, j, 1).couleur & vbTab & cellier(i, j, 1).region & vbTab & cellier(i, j, 1).annee & vbTab & cellier(i, j, 1).prix & vbTab & cellier(i, j, 1).quantite)
  343. End If
  344. End If
  345. Next
  346. Next
  347. End Sub
  348.  
  349. Private Sub obRouge2_Click() 'Affiche les cépages associé au vins rouges quand le optionButton "Rouge" est selectionné
  350. 'combobox Cepage
  351. cmbCepage.Clear
  352. For i = 2 To 8
  353. cmbCepage.AddItem (sheetCepage.Cells(i, 1).Value)
  354. Next
  355. End Sub
  356.  
  357. Private Sub obBlanc2_Click() 'Affiche les cépages associé au vins rouges quand le optionButton "Rouge" est selectionné
  358. 'combobox Cepage
  359. cmbCepage.Clear
  360. For i = 2 To 8
  361. cmbCepage.AddItem (sheetCepage.Cells(i, 3).Value)
  362. Next
  363. End Sub
  364.  
  365. Private Sub cmbGustaCar_Change() 'Change le contenu du txfGusta pour la description de la caractéristique selectionnée
  366. txfGustaCar.Text = sheetCarac.Cells(cmbGustaCar.ListIndex + 3, 8).Value
  367. End Sub
  368.  
  369. Private Sub cmbOlfaCar_Change() 'Change le contenu du txfOlfa pour la description de la caractéristique selectionnée
  370. txfOlfaCar.Text = sheetCarac.Cells(cmbOlfaCar.ListIndex + 3, 5).Value
  371. End Sub
  372.  
  373. Private Sub cmbVisuCar_Change() 'Change le contenu du txfVisu pour la description de la caractéristique selectionnée
  374. txfVisuCar.Text = sheetCarac.Cells(cmbVisuCar.ListIndex + 3, 2).Value
  375. End Sub
  376.  
  377. Private Sub cmbPastille_Change() 'Change l'image dans le contrôle imgPastille pour la pastille choisie dans le ComboBox cmbPastille
  378. Dim chemin As String: chemin = ThisWorkbook.path & "\Images\Pastilles\"
  379. Select Case cmbPastille.Value
  380. Case "Fruité et léger"
  381. imgPastille.Picture = LoadPicture(chemin & "fruiteLeger.jpg")
  382. Case "Fruité et généreux"
  383. imgPastille.Picture = LoadPicture(chemin & "fruiteGenereux.jpg")
  384. Case "Aromatique et souple"
  385. imgPastille.Picture = LoadPicture(chemin & "aromeSouple.jpg")
  386. Case "Aromatique et charnu"
  387. imgPastille.Picture = LoadPicture(chemin & "aromeCharnu.jpg")
  388. Case "Délicat et léger"
  389. imgPastille.Picture = LoadPicture(chemin & "delicatLeger.jpg")
  390. Case "Fruité et vif"
  391. imgPastille.Picture = LoadPicture(chemin & "fruiteVif.jpg")
  392. Case "Aromatique et rond"
  393. imgPastille.Picture = LoadPicture(chemin & "aromeRond.jpg")
  394. Case "Fruité et doux"
  395. imgPastille.Picture = LoadPicture(chemin & "fruiteDoux.jpg")
  396. Case "Fruité et extra-doux"
  397. imgPastille.Picture = LoadPicture(chemin & "fruiteExtraDoux.jpg")
  398. End Select
  399. UserForm1.Repaint
  400. End Sub
  401.  
  402. Sub cellierDefaut() 'Remet l'image par défaut (pas de sélection) dans tout les contrôles ImageBox
  403. img1.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  404. img2.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  405. img3.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  406. img4.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  407. img5.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  408. img6.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  409. img7.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  410. img8.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  411. img9.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  412. img10.Picture = LoadPicture(ThisWorkbook.path & "\Images\select0.jpg")
  413.  
  414. txfNom.Value = ""
  415. txfRegion.Value = ""
  416. txfAnnee.Value = ""
  417. txfPrix.Value = ""
  418. cmbFormat.Value = ""
  419. cmbCepage.Value = ""
  420. cmbPastille.Value = ""
  421. cmbVisuelle.Value = ""
  422. cmbOlfactive.Value = ""
  423. cmbGustative.Value = ""
  424. txfQuantite.Value = ""
  425. txfPourAlc.Value = ""
  426.  
  427. For Each ctrl In Me.Controls
  428. If TypeName(ctrl) = "OptionButton" Then
  429. If (ctrl.Value = True) And (ctrl.GroupName = "grpAjouter") Then
  430. ctrl.Value = False
  431. End If
  432. End If
  433. Next
  434.  
  435. imgPastille.Picture = LoadPicture(ThisWorkbook.path & "\Images\pastilleDefaut.jpg")
  436. imgVin.Picture = LoadPicture(ThisWorkbook.path & "\Images\vinBase.jpg")
  437.  
  438. UserForm1.Repaint
  439. End Sub
  440.  
  441.  
  442.  
  443. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  444. '@@ Les 10 méthodes suivantes gèrent la sélection du cellier (et le casier du cellier) sur lequel l'utilisateur a cliqué @@
  445. '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  446.  
  447. Private Sub img1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  448. Dim imgHauteur: imgHauteur = img1.Height
  449. Dim imgLargeur: imgLargeur = img1.Width
  450.  
  451. selection(1) = 1
  452.  
  453. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  454. cellierDefaut
  455. img1.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  456. UserForm1.Repaint
  457. selection(2) = 1
  458. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  459. cellierDefaut
  460. img1.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  461. UserForm1.Repaint
  462. selection(2) = 2
  463. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  464. cellierDefaut
  465. img1.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  466. UserForm1.Repaint
  467. selection(2) = 3
  468. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  469. cellierDefaut
  470. img1.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  471. UserForm1.Repaint
  472. selection(2) = 4
  473. End If
  474.  
  475. estSelection = True
  476.  
  477. End Sub
  478.  
  479. Private Sub img2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  480. Dim imgHauteur: imgHauteur = img2.Height
  481. Dim imgLargeur: imgLargeur = img2.Width
  482.  
  483. selection(1) = 2
  484.  
  485. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  486. cellierDefaut
  487. img2.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  488. UserForm1.Repaint
  489. selection(2) = 1
  490. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  491. cellierDefaut
  492. img2.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  493. UserForm1.Repaint
  494. selection(2) = 2
  495. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  496. cellierDefaut
  497. img2.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  498. UserForm1.Repaint
  499. selection(2) = 3
  500. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  501. cellierDefaut
  502. img2.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  503. UserForm1.Repaint
  504. selection(2) = 4
  505. End If
  506.  
  507. estSelection = True
  508.  
  509. End Sub
  510.  
  511. Private Sub img3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  512. Dim imgHauteur: imgHauteur = img3.Height
  513. Dim imgLargeur: imgLargeur = img3.Width
  514.  
  515. selection(1) = 3
  516.  
  517. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  518. cellierDefaut
  519. img3.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  520. UserForm1.Repaint
  521. selection(2) = 1
  522. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  523. cellierDefaut
  524. img3.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  525. UserForm1.Repaint
  526. selection(2) = 2
  527. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  528. cellierDefaut
  529. img3.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  530. UserForm1.Repaint
  531. selection(2) = 3
  532. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  533. cellierDefaut
  534. img3.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  535. UserForm1.Repaint
  536. selection(2) = 4
  537. End If
  538.  
  539. estSelection = True
  540.  
  541. End Sub
  542.  
  543. Private Sub img4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  544. Dim imgHauteur: imgHauteur = img4.Height
  545. Dim imgLargeur: imgLargeur = img4.Width
  546.  
  547. selection(1) = 4
  548.  
  549. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  550. cellierDefaut
  551. img4.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  552. UserForm1.Repaint
  553. selection(2) = 1
  554. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  555. cellierDefaut
  556. img4.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  557. UserForm1.Repaint
  558. selection(2) = 2
  559. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  560. cellierDefaut
  561. img4.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  562. UserForm1.Repaint
  563. selection(2) = 3
  564. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  565. cellierDefaut
  566. img4.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  567. UserForm1.Repaint
  568. selection(2) = 4
  569. End If
  570.  
  571. estSelection = True
  572.  
  573. End Sub
  574.  
  575. Private Sub img5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  576. Dim imgHauteur: imgHauteur = img5.Height
  577. Dim imgLargeur: imgLargeur = img5.Width
  578.  
  579. selection(1) = 5
  580.  
  581. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  582. cellierDefaut
  583. img5.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  584. UserForm1.Repaint
  585. selection(2) = 1
  586. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  587. cellierDefaut
  588. img5.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  589. UserForm1.Repaint
  590. selection(2) = 2
  591. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  592. cellierDefaut
  593. img5.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  594. UserForm1.Repaint
  595. selection(2) = 3
  596. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  597. cellierDefaut
  598. img5.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  599. UserForm1.Repaint
  600. selection(2) = 4
  601. End If
  602.  
  603. estSelection = True
  604.  
  605. End Sub
  606.  
  607. Private Sub img6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  608. Dim imgHauteur: imgHauteur = img6.Height
  609. Dim imgLargeur: imgLargeur = img6.Width
  610.  
  611. selection(1) = 6
  612.  
  613. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  614. cellierDefaut
  615. img6.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  616. UserForm1.Repaint
  617. selection(2) = 1
  618. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  619. cellierDefaut
  620. img6.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  621. UserForm1.Repaint
  622. selection(2) = 2
  623. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  624. cellierDefaut
  625. img6.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  626. UserForm1.Repaint
  627. selection(2) = 3
  628. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  629. cellierDefaut
  630. img6.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  631. UserForm1.Repaint
  632. selection(2) = 4
  633. End If
  634.  
  635. estSelection = True
  636.  
  637. End Sub
  638.  
  639. Private Sub img7_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  640. Dim imgHauteur: imgHauteur = img7.Height
  641. Dim imgLargeur: imgLargeur = img7.Width
  642.  
  643. selection(1) = 7
  644.  
  645. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  646. cellierDefaut
  647. img7.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  648. UserForm1.Repaint
  649. selection(2) = 1
  650. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  651. cellierDefaut
  652. img7.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  653. UserForm1.Repaint
  654. selection(2) = 2
  655. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  656. cellierDefaut
  657. img7.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  658. UserForm1.Repaint
  659. selection(2) = 3
  660. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  661. cellierDefaut
  662. img7.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  663. UserForm1.Repaint
  664. selection(2) = 4
  665. End If
  666.  
  667. estSelection = True
  668.  
  669. End Sub
  670.  
  671. Private Sub img8_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  672. Dim imgHauteur: imgHauteur = img8.Height
  673. Dim imgLargeur: imgLargeur = img8.Width
  674.  
  675. selection(1) = 8
  676.  
  677. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  678. cellierDefaut
  679. img8.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  680. UserForm1.Repaint
  681. selection(2) = 1
  682. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  683. cellierDefaut
  684. img8.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  685. UserForm1.Repaint
  686. selection(2) = 2
  687. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  688. cellierDefaut
  689. img8.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  690. UserForm1.Repaint
  691. selection(2) = 3
  692. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  693. cellierDefaut
  694. img8.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  695. UserForm1.Repaint
  696. selection(2) = 4
  697. End If
  698.  
  699. estSelection = True
  700.  
  701. End Sub
  702.  
  703. Private Sub img9_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  704. Dim imgHauteur: imgHauteur = img9.Height
  705. Dim imgLargeur: imgLargeur = img9.Width
  706.  
  707. selection(1) = 9
  708.  
  709. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  710. cellierDefaut
  711. img9.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  712. UserForm1.Repaint
  713. selection(2) = 1
  714. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  715. cellierDefaut
  716. img9.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  717. UserForm1.Repaint
  718. selection(2) = 2
  719. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  720. cellierDefaut
  721. img9.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  722. UserForm1.Repaint
  723. selection(2) = 3
  724. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  725. cellierDefaut
  726. img9.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  727. UserForm1.Repaint
  728. selection(2) = 4
  729. End If
  730.  
  731. estSelection = True
  732.  
  733. End Sub
  734.  
  735. Private Sub img10_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  736. Dim imgHauteur: imgHauteur = img10.Height
  737. Dim imgLargeur: imgLargeur = img10.Width
  738.  
  739. selection(1) = 10
  740.  
  741. If (X < imgHauteur / 2) And (Y < imgLargeur / 2) Then
  742. cellierDefaut
  743. img10.Picture = LoadPicture(ThisWorkbook.path & "\Images\select1.jpg")
  744. UserForm1.Repaint
  745. selection(2) = 1
  746. ElseIf (X > imgHauteur / 2) And (Y < imgLargeur / 2) Then
  747. cellierDefaut
  748. img10.Picture = LoadPicture(ThisWorkbook.path & "\Images\select2.jpg")
  749. UserForm1.Repaint
  750. selection(2) = 2
  751. ElseIf (X < imgHauteur / 2) And (Y > imgLargeur / 2) Then
  752. cellierDefaut
  753. img10.Picture = LoadPicture(ThisWorkbook.path & "\Images\select3.jpg")
  754. UserForm1.Repaint
  755. selection(2) = 3
  756. ElseIf (X > imgHauteur / 2) And (Y > imgLargeur / 2) Then
  757. cellierDefaut
  758. img10.Picture = LoadPicture(ThisWorkbook.path & "\Images\select4.jpg")
  759. UserForm1.Repaint
  760. selection(2) = 4
  761. End If
  762.  
  763. estSelection = True
  764.  
  765. End Sub
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!