Bonjour,
j'ai un userform avec un listBox 1 j'aimerai rajouter un listBox 2 qui va aller chercher les elements dans la meme fichier mais a une autres position .
j'ai ce code que je voudrais modifier
Private Sub CommandButton1_Click()
Dim R As Range
Dim var
Dim i&
Dim bool
Set R = ActiveSheet.Range("a111")
var = R
var(1, 13) = NOM_SELECTIONNE
var(3, 13) = Me.TextBox1
var(9, 13) = Me.TextBox2
var(8, 13) = Me.TextBox3
var(10, 6) = Me.TextBox4
var(9, 6) = Me.TextBox5
var(11, 6) = Me.TextBox6
var(2, 13) = Me.TextBox7
var(5, 13) = Me.TextBox8
var(2, 15) = Me.TextBox9
var(2, 16) = Me.TextBox10
var(2, 14) = Me.TextBox11
ActiveSheet.Unprotect ("fldp")
R = var
Range("AB9").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("X10").Select
Application.CutCopyMode = False
Selection.Copy
Range("B8:I8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("S8").Select
Application.CutCopyMode = False
Selection.Copy
Range("M44").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("X9").Select
Application.CutCopyMode = False
Selection.Copy
Range("M77").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Range("S5").Select
Application.CutCopyMode = False
Selection.Copy
Range("M1010").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Range("M6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M6").Select
Range("B1").Select
ActiveSheet.Protect ("fldp")
End Sub
Et celui la
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i&
With Me.ListBox1
For i& = 0 To .ListCount - 1
If .Selected(i&) = True Then
NOM_SELECTIONNE = .Column(0)
Me.TextBox1 = .Column(1)
Me.TextBox2 = .Column(3)
Me.TextBox3 = .Column(4)
Me.TextBox7 = .Column(5)
Me.TextBox8 = .Column(6)
Me.TextBox11 = .Column(7)
Me.TextBox9 = .Column(8)
Me.TextBox10 = .Column(9)
End If
Next i&
End With
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i&
With Me.ListBox2
For i& = 0 To .ListCount - 1
If .Selected(i&) = True Then
NOM_SELECTIONNE = .Column(0)
End If
Next i&
End With
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox4) Then
TextBox4 = Format(TextBox4, "dd/mm/yyyy")
Else
MsgBox "Saisissez la date au format jj/mm/aaaa"
TextBox4 = ""
End If
End Sub
Private Sub UserForm_Initialize()
Dim var
var = Sheets("adresse client").Range("a2:m" & Sheets("adresse client").[a65536].End(xlUp).Row & "")
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "20;0;0;0;0"
.List = var
End With
End Sub
si vous avez la solution
merci
j'ai un userform avec un listBox 1 j'aimerai rajouter un listBox 2 qui va aller chercher les elements dans la meme fichier mais a une autres position .
j'ai ce code que je voudrais modifier
Private Sub CommandButton1_Click()
Dim R As Range
Dim var
Dim i&
Dim bool
Set R = ActiveSheet.Range("a111")
var = R
var(1, 13) = NOM_SELECTIONNE
var(3, 13) = Me.TextBox1
var(9, 13) = Me.TextBox2
var(8, 13) = Me.TextBox3
var(10, 6) = Me.TextBox4
var(9, 6) = Me.TextBox5
var(11, 6) = Me.TextBox6
var(2, 13) = Me.TextBox7
var(5, 13) = Me.TextBox8
var(2, 15) = Me.TextBox9
var(2, 16) = Me.TextBox10
var(2, 14) = Me.TextBox11
ActiveSheet.Unprotect ("fldp")
R = var
Range("AB9").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("X10").Select
Application.CutCopyMode = False
Selection.Copy
Range("B8:I8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("S8").Select
Application.CutCopyMode = False
Selection.Copy
Range("M44").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Unload Me
Range("X9").Select
Application.CutCopyMode = False
Selection.Copy
Range("M77").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Range("S5").Select
Application.CutCopyMode = False
Selection.Copy
Range("M1010").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B2:G2").Select
Range("M6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M6").Select
Range("B1").Select
ActiveSheet.Protect ("fldp")
End Sub
Et celui la
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i&
With Me.ListBox1
For i& = 0 To .ListCount - 1
If .Selected(i&) = True Then
NOM_SELECTIONNE = .Column(0)
Me.TextBox1 = .Column(1)
Me.TextBox2 = .Column(3)
Me.TextBox3 = .Column(4)
Me.TextBox7 = .Column(5)
Me.TextBox8 = .Column(6)
Me.TextBox11 = .Column(7)
Me.TextBox9 = .Column(8)
Me.TextBox10 = .Column(9)
End If
Next i&
End With
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i&
With Me.ListBox2
For i& = 0 To .ListCount - 1
If .Selected(i&) = True Then
NOM_SELECTIONNE = .Column(0)
End If
Next i&
End With
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox4) Then
TextBox4 = Format(TextBox4, "dd/mm/yyyy")
Else
MsgBox "Saisissez la date au format jj/mm/aaaa"
TextBox4 = ""
End If
End Sub
Private Sub UserForm_Initialize()
Dim var
var = Sheets("adresse client").Range("a2:m" & Sheets("adresse client").[a65536].End(xlUp).Row & "")
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "20;0;0;0;0"
.List = var
End With
End Sub
si vous avez la solution
merci