Dim rng
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X > rng.Cells(1).Width Then col = 2 Else col = 1
With ListBox1
ListBox1.ControlTipText = "vous etes dans la cellule " & Cells(Round(Y / 10) + 1, col).Address
End With
End Sub
Private Sub UserForm_Activate()
Set rng = [A1:B10]
ListBox1.List = rng.Value
ListBox1.ColumnCount = 3
For i = 1 To rng.Columns.Count
blabla = blabla & rng.Columns(i).Width & IIf(i < rng.Columns.Count, ";", "")
Next
ListBox1.ColumnWidths = blabla
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X > rng.Cells(1).Width Then col = 2 Else col = 1
With ListBox1
H = Label1.Height
If .ListIndex = 0 Then z = 0 Else z = 1
ListBox1.ControlTipText = "vous etes dans la cellule " & Cells(.ListIndex + 1, col).Address
End With
End Sub
Private Sub UserForm_Activate()
Set rng = [A1:B10]
Label1.Font.Size = ListBox1.Font.Size
ListBox1.List = rng.Value
ListBox1.ColumnCount = 3
For i = 1 To rng.Columns.Count
blabla = blabla & rng.Columns(i).Width & IIf(i < rng.Columns.Count, ";", "")
Next
ListBox1.ColumnWidths = blabla
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim v As Variant
With ListBox1
v = Application.InputBox("Entrez la nouvelle valeur :", "Modifier", .List(.ListIndex), Type:=2)
If v = False Or v = "" Then Exit Sub
Sheets("Feuil1").Cells(.ListIndex + 1, 1) = v
End With
UserForm_Initialize
End Sub
Private Sub UserForm_Initialize()
ListBox1.List = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 2).Value 'au moins 2 éléments
End Sub
Je ne vois pas le rapport avec le sujet de ce fil mais j'en profite pour proposer ce fichier (2).Pour adapter automatiquement les largeurs de colonnes
Option Compare Text
Dim f, TblBD, ColVisu(), NbCol, arrayColHead(), TblNoncontiG
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Rng = f.Range("A2:P" & f.[A65000].End(xlUp).Row)
TblBD = Rng.Value ' rapidité
arrayColHead = Array(1, 2, 3, 5, 6, 7, 8, 10, 11, 12, 13, 15) ' Colonnes à visualiser (adapter)
TblNoncontiG = Application.Index(TblBD, Evaluate("ROW(" & 1 & ":" & Rng.Rows.Count & ")"), arrayColHead)
ReDim ColVisu(2, UBound(arrayColHead))
For i = 0 To UBound(arrayColHead)
ColVisu(0, i) = Rng.Cells(1, arrayColHead(i)).Offset(-1).Text
ColVisu(1, i) = Rng.Cells(1, arrayColHead(i)).Width
Next
' MsgBox "les entetes " & vbCrLf & Join(WorksheetFunction.Index(ColVisu, 1, 0), ";")
'MsgBox " le columnwidth " & vbCrLf & Join(WorksheetFunction.Index(ColVisu, 2, 0), ";")
With ListBox1
.List = TblNoncontiG
.ColumnCount = UBound(arrayColHead) + 1
.ColumnWidths = Join(WorksheetFunction.Index(ColVisu, 2, 0), ";")
End With
EnteteListBox ColVisu, ListBox1, True
End Sub
Sub EnteteListBox(TBL, LtBX, Optional separateurV As Boolean = False)
Dim X#, C&, ec#
X = LtBX.Left
ec = IIf(LtBX.TextAlign = 1, 6, 4) 'selectionmargin non dispo dans listbox
For C = 0 To UBound(TBL, 2)
With Me.Controls.Add("Forms.Label.1", , True)
.Left = X: .Height = 12: .Top = LtBX.Top - .Height + 2: .Width = TBL(1, C) + IIf(C = 0, ec, 0)
.BorderStyle = 1: .TextAlign = LtBX.TextAlign
'If C = UBound(TBL, 2) Then .Width = LtBX.Width + 10 - X
.Caption = TBL(0, C)
End With
'separateurs colonnes
If C > 0 And separateurV Then
With Me.Controls.Add("Forms.ListBox.1", "Sep0" & C, True)
.Top = LtBX.Top: .Left = X - 1: .Height = LtBX.Height: .Width = 1
.Enabled = False
.BorderStyle = 0: .BorderColor = vbBlack 'RGB(200, 200, 200)
End With
End If
X = X + TBL(1, C) + IIf(C = 0, ec, 0)
Next
End Sub