Re : userform en chantier
Bonsoir à tous, le Forum,
Voici ce que j'ai pu obtenir :
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} selecvaleur2
Caption = "UserForm3"
ClientHeight = 2970
ClientLeft = 45
ClientTop = 435
ClientWidth = 6600
OleObjectBlob = "selecvaleur2.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "selecvaleur2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nomfeuille1 As String
Dim lig As Long
Private Sub TextBox2_Change()
End Sub
'--------------------------------------------
' Module : selecvaleur/UserForm_QueryClose
' Utilisation
as la croix rouge
'--------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.Value = "" Then
Call MsgBox("Vous devez sélectionner une valeur", vbCritical, Application.Name)
ComboBox1.SetFocus
Exit Sub
End If
If Not IsDate(TextBox2.Value) Then
Call MsgBox("Vous devez entrer une date" _
& vbCrLf & "jj/mm/aaaa" _
, vbCritical, Application.Name)
TextBox2.Value = ""
TextBox2.SetFocus
Exit Sub
End If
lig = CLng(ComboBox1.List(ComboBox1.ListIndex, ComboBox1.ColumnCount - 1))
Select Case MsgBox("Les données de :" _
& vbCrLf & "nom :" & ComboBox1.Value _
& vbCrLf & "Prénom :" & ComboBox1.List(ComboBox1.ListIndex, 2) _
& vbCrLf & "Ligne :" & lig _
& vbCrLf & "vont être supprimés" _
& vbCrLf & "" _
& vbCrLf & "Etes vous d'accord" _
& vbCrLf & "" _
, vbYesNo Or vbExclamation Or vbDefaultButton1, Application.Name)
Case vbYes
Call ajoutlig("BASE RESILIES", "a", "BASE ACTIFS", lig)
Case vbNo
Exit Sub
End Select
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
ComboBox1.Visible = True
Label2.Visible = True
Me.Caption = "Selectionner une personne"
Call remplircomboaveccond
'selecvaleur2.Caption = message
End Sub
Sub remplircomboaveccond()
'Déclare un tableau à 2 dimensions.
Dim £Tableau() As String
Dim £cellule As Range
Dim £i As Long, £j As Integer, £y As Integer
Dim £numColTri As Byte 'numéro de la colonne à trier
Dim £nbCol As Byte ' nombre de colonne
Dim £t As Variant
'Dim £Resultat As String
£nbCol = 3
nomfeuille1 = "BASE ACTIFS"
£i = Sheets(nomfeuille1).Range("a65536").End(xlUp).Row + 2 ' taille du tableau
'Dim £Tableau(1 To 4, 1 To 4, 1 To 4, 1 To 4) As String
ReDim £Tableau(1 To £i, 1 To £nbCol)
'Remplir le tableau
£i = 1
For Each £cellule In Sheets(nomfeuille1).Range("a3:a" & Sheets(nomfeuille1).Range("b65536").End(xlUp).Row)
£Tableau(£i, 1) = £cellule.Value
£Tableau(£i, 2) = £cellule.Offset(0, 1).Value
£Tableau(£i, 3) = £cellule.Row
£i = £i + 1
Next £cellule
' trier le tableau
£numColTri = 1 'colonne à trier
For £i = 1 To UBound(£Tableau, £numColTri)
For £j = 1 To UBound(£Tableau, £numColTri)
If £Tableau(£j, £numColTri) > £Tableau(£i, £numColTri) Then
For £y = 1 To £nbCol
£t = £Tableau(£i, £y)
£Tableau(£i, £y) = £Tableau(£j, £y)
£Tableau(£j, £y) = £t
Next £y
End If
Next £j
Next £i
With ComboBox1
.Clear
.ColumnCount = £nbCol
.ColumnWidths = "80;60;0"
.Style = fmStyleDropDownList '
.BoundColumn = 1 ' combobox1.text contient le nom
For £i = 1 To UBound(£Tableau, £numColTri)
If £Tableau(£i, 1) <> "" Then
.AddItem £Tableau(£i, 1)
.List(.ListCount - 1, 1) = £Tableau(£i, 2)
.List(.ListCount - 1, 2) = £Tableau(£i, 3)
End If
Next £i
End With
End Sub
Private Sub ajoutlig(£nomdest As String, £col As String, £nomorigine As String, £ligacop As Long)
' call ajoutlig( "feuille destination", "colonne pour trouver la dernière ligne", "feuille origine", "ligne à copier")
With Sheets(£nomdest)
Sheets(£nomorigine).Rows(£ligacop).Copy _
Destination:=.Rows(.Range(£col & "65536").End(xlUp).Row + 1)
Sheets(£nomorigine).Rows(£ligacop).Delete Shift:=xlUp
End With
End Sub