Bonjour à tous
J'ai un code VB avec deux Combobox qui alimenteent 2 textboxs avec tri
automatique.
J'aimerai alimenter une 3 textbox avec cette combobox voir code joint.
Voir égalemnt pour activer la macro clignotte
Merci
Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim T()
Dim var
Dim i&
Dim C As Control
On Error GoTo Erreur
Set S = Sheets(MA_FEUILLE)
Set R = S.Range("b" & LIG_DEPART & ":b" & S.[b65536].End(xlUp).Row & "")
ReDim T(1 To R.Rows.Count, 1 To 2)
var = R
For i& = 1 To UBound(T, 1)
T(i&, 1) = i&
T(i&, 2) = var(i&, 1)
Next i&
Set S = Nothing
Set S = Sheets.Add
Set R = S.Range("a1:b" & UBound(T, 1) & "")
R = T
R.Sort key1:=S.[b1], order1:=xlAscending
var = S.Range(R.Address)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
With V1
.ColumnCount = 2
.ColumnWidths = "0;50"
.List = var
.SetFocus
End With
With P2
.ColumnCount = 2
.ColumnWidths = "0;50"
.List = var
End With
For Each C In Me.Controls
If TypeName(C) = "TextBox" Then
With C.Font
If NUM_vs_NOM Then
.Size = 16
Else
.Size = 8
End If
End With
End If
Next C
Erreur:
If Not S Is Nothing Then S.Delete
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Private Sub Annuler_Click()
Dim C As Control
For Each C In Me.Controls
On Error Resume Next
C.Value = ""
Next C
'Unload Me
End Sub
Module clignotte:
Sub Clignotement()
Dim TempsClign As Single
Dim Depart As Single
Dim Fin As Single
Dim MemTimer As Single
Const TempsAllum = 0.3 ' Temps "d'allumage"
Const TempsExtinc = 0.3 ' Temps "d'extinction"
TempsClign = 10 ' Durée totale des clignotements
Depart = Timer
Do While Timer < Depart + TempsClign
MemTimer = Timer
Do While Timer < MemTimer + TempsExtinc
DoEvents
SaisieMatch.Label8.ForeColor = &H0 ' Texte invisible (de la couleur du fond)
Loop
MemTimer = Timer
Do While Timer < MemTimer + TempsAllum
DoEvents
SaisieMatch.Label8.ForeColor = &H8000000D ' Texte visible
Loop
DoEvents ' Laisse le contrôle à d'autres processus.
Loop
End Sub
J'ai un code VB avec deux Combobox qui alimenteent 2 textboxs avec tri
automatique.
J'aimerai alimenter une 3 textbox avec cette combobox voir code joint.
Voir égalemnt pour activer la macro clignotte
Merci
Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim T()
Dim var
Dim i&
Dim C As Control
On Error GoTo Erreur
Set S = Sheets(MA_FEUILLE)
Set R = S.Range("b" & LIG_DEPART & ":b" & S.[b65536].End(xlUp).Row & "")
ReDim T(1 To R.Rows.Count, 1 To 2)
var = R
For i& = 1 To UBound(T, 1)
T(i&, 1) = i&
T(i&, 2) = var(i&, 1)
Next i&
Set S = Nothing
Set S = Sheets.Add
Set R = S.Range("a1:b" & UBound(T, 1) & "")
R = T
R.Sort key1:=S.[b1], order1:=xlAscending
var = S.Range(R.Address)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
With V1
.ColumnCount = 2
.ColumnWidths = "0;50"
.List = var
.SetFocus
End With
With P2
.ColumnCount = 2
.ColumnWidths = "0;50"
.List = var
End With
For Each C In Me.Controls
If TypeName(C) = "TextBox" Then
With C.Font
If NUM_vs_NOM Then
.Size = 16
Else
.Size = 8
End If
End With
End If
Next C
Erreur:
If Not S Is Nothing Then S.Delete
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Private Sub Annuler_Click()
Dim C As Control
For Each C In Me.Controls
On Error Resume Next
C.Value = ""
Next C
'Unload Me
End Sub
Module clignotte:
Sub Clignotement()
Dim TempsClign As Single
Dim Depart As Single
Dim Fin As Single
Dim MemTimer As Single
Const TempsAllum = 0.3 ' Temps "d'allumage"
Const TempsExtinc = 0.3 ' Temps "d'extinction"
TempsClign = 10 ' Durée totale des clignotements
Depart = Timer
Do While Timer < Depart + TempsClign
MemTimer = Timer
Do While Timer < MemTimer + TempsExtinc
DoEvents
SaisieMatch.Label8.ForeColor = &H0 ' Texte invisible (de la couleur du fond)
Loop
MemTimer = Timer
Do While Timer < MemTimer + TempsAllum
DoEvents
SaisieMatch.Label8.ForeColor = &H8000000D ' Texte visible
Loop
DoEvents ' Laisse le contrôle à d'autres processus.
Loop
End Sub
