Discussion :

[Sliver]

Bonjour a tous,

Dans le fichier joint j'ai ajouter une Spreadsheet a un usf. je voudrais le renseigné avec une combobox. est il possible de le faire?
Choisir un fournisseur avec la combo et que la selection s affiche dans la feuill excel.

Cordialement

[PMO2017]

Bonjour,

Copiez le code suivant dans la fenêtre de code du UserForm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Dim S As Worksheet
Dim R As Range
Dim var
 
Private Sub UserForm_Initialize()
Dim T()
Dim i&
Dim cpt&
Set S = Sheets("Produits")
Set R = S.[a1].CurrentRegion
R.Sort Key1:=S.Range("A2"), Order1:=xlAscending, Header:=xlYes
var = R
For i& = 2 To UBound(var, 1)
  If i& = 2 Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To cpt&)
    T(cpt&) = var(i&, 1)
  Else
    If var(i&, 1) <> var(i& - 1, 1) Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To cpt&)
      T(cpt&) = var(i&, 1)
    End If
  End If
  Me.ComboBox1.List = T
Next i&
End Sub
 
Private Sub ComboBox1_Change()
Dim SP As Spreadsheet
Dim i&
Dim ligDeb&
Dim ligFin&
Set SP = Me.Spreadsheet1
For i& = 2 To UBound(var, 1)
  If var(i&, 1) = ComboBox1.Value Then
    ligDeb& = i&
    Exit For
  End If
Next i&
For i& = ligDeb& To UBound(var, 1)
  If var(i&, 1) <> ComboBox1.Value Then
    ligFin& = i& - 1
    Exit For
  End If
Next i&
If ligFin& = 0 Then ligFin& = UBound(var, 1)
SP.Cells.ClearContents
S.Range("a1:e1").Copy
SP.Range("a1:e1").Paste
S.Range(S.Cells(ligDeb&, 1), S.Cells(ligFin&, 5)).Copy
SP.Range("a2:e" & ligFin& - ligDeb& + 2 & "").Paste
SP.Columns.AutoFit
SP.Range("a1").Select
End Sub

Cordialement.

PMO
Patrick Morange