Bonjour
Dans un de mes userform j'ai cet deux lignes
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
qui génére l'erreur "Type défini par l'utilisateur non défini" si vous avez une solution SVP merci
voici le code
Private Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Option Compare Text
Option Explicit
Dim Mem_Code_Art
Private Sub Ajouter_Click()
Dim derligne As Integer
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
derligne = Sheets("Feuil3").Range("A456541").End(xlUp).Row + 1
Cells(derligne, 1) = TextBox12.Value
Cells(derligne, 2) = TextBox2.Value
Cells(derligne, 3) = TextBox3.Value
Cells(derligne, 4) = TextBox4.Value
Cells(derligne, 5) = TextBox5.Value
Cells(derligne, 6) = TextBox6.Value
Cells(derligne, 7) = TextBox7.Value
Cells(derligne, 8) = TextBox8.Value
Cells(derligne, 9) = TextBox9.Value
Cells(derligne, 10) = TextBox10.Value
Call Majour_Lvw
End If
End Sub
Private Sub CommandButton1_Click()
Unload Userform51
End Sub
Private Sub Majour_Lsvw_Click()
Call Majour_Lvw
End Sub
Private Sub Supprimer_Click()
Dim cel As Range, lig&, I&, rep, Nb
Nb = Application.CountIf(Columns(1), Mem_Code_Art)
If Nb > 0 Then
lig = 2
lig = Columns(1).Find(Mem_Code_Art, Cells(lig, 1), , xlWhole).Row
rep = MsgBox("ATTENTION Vous allez Supprimer la ligne, action Irréversible", vbCritical + vbYesNo, "Suppression")
If rep = vbNo Then Exit Sub
With Feuil3
.Rows(lig).Delete
End With
Call Majour_Lvw
Else
MsgBox " xxxxxxx n'existe pas !!!!!!!!!!!!!!!!!!!"
End If
End Sub
Private Sub Modifier_Click()
Dim Nb, lig As Long, ligLst As Long, J
If Me.ListView1.SelectedItem.Index > 0 Then
Nb = Application.CountIf(Columns(1), Mem_Code_Art)
If Nb > 0 Then
lig = 2
lig = Columns(1).Find(Mem_Code_Art, Cells(lig, 1), , xlWhole).Row
Cells(lig, 1) = TextBox12
TextBox12.Value = ""
For J = 2 To 10
Cells(lig, J).Value = Me.Controls("TextBox" & J)
Me.Controls("TextBox" & J) = ""
Next J
Call Majour_Lvw
End If
End If
End Sub
Private Sub TextBox8_Change()
If TextBox8 = "xxxxxxxx" Then
TextBox12.ForeColor = vbRed
TextBox2.ForeColor = vbRed
TextBox3.ForeColor = vbRed
TextBox4.ForeColor = vbRed
TextBox5.ForeColor = vbRed
TextBox6.ForeColor = vbRed
TextBox7.ForeColor = vbRed
TextBox8.ForeColor = vbRed
TextBox9.ForeColor = vbRed
TextBox10.ForeColor = vbRed
Else
TextBox12.ForeColor = vbBlack
TextBox2.ForeColor = vbBlack
TextBox3.ForeColor = vbBlack
TextBox4.ForeColor = vbBlack
TextBox5.ForeColor = vbBlack
TextBox6.ForeColor = vbBlack
TextBox7.ForeColor = vbBlack
TextBox8.ForeColor = vbBlack
TextBox9.ForeColor = vbBlack
TextBox10.ForeColor = vbBlack
End If
End Sub
Private Sub TextBox1_Change()
Dim I As Long
Dim c As Range
ListView1.ListItems.Clear
If TextBox1 <> "" Then
With Sheets("Feuil3")
I = 2
Do
For Each c In .Range(.Cells(I, 1), .Cells(I, 10))
If UCase(CStr(c.Value)) = UCase(TextBox1.Value) Or InStr(CStr(c), TextBox1) > 0 Then
IniLvw12 c.Row
Exit For
End If
Next c
I = I + 1
Loop While .Cells(I, 1) <> ""
End With
Else
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox6 = ""
Me.TextBox7 = ""
Me.TextBox8 = ""
Me.TextBox9 = ""
Me.TextBox10 = ""
Me.TextBox12 = ""
Call Majour_Lvw
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.Sorted = False
ListView1.SortKey = ColumnHeader.Index - 1
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim I As Integer
Dim J As Integer
Dim x
I = Me.ListView1.SelectedItem.Index
TextBox12 = ListView1.ListItems(I)
Mem_Code_Art = TextBox12.Value
For J = 1 To Me.ListView1.ColumnHeaders.Count - 1
Me.Controls("Textbox" & J + 1) = ListView1.ListItems(I).ListSubItems(J).Text
Next J
End Sub
Sub IniLvw12(a As Long)
Dim x
Dim I
Dim J
Dim c
With ListView1
.ListItems.Add , , Sheets("Feuil3").Cells(a, 1)
For I = 1 To 9
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Feuil3").Cells(a, I + 1)
Next
.ListItems(.ListItems.Count).ListSubItems.Add , , a
For I = 1 To .ListItems.Count
If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
For J = 1 To .ColumnHeaders.Count - 1
If .ListItems(I).ListSubItems(7).Text = "xxxxxxxx" Then
.ListItems(I).Bold = True
.ListItems(I).ForeColor = vbRed
For c = 1 To .ColumnHeaders.Count
.ListItems(I).ListSubItems(c).Bold = True
.ListItems(I).ListSubItems(c).ForeColor = vbRed
Next c
End If
Next J
Next I
End With
End Sub
Private Sub UserForm_Activate()
EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
End Sub
Private Sub UserForm_Initialize()
Dim hWnd As Long
Dim ligne
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
With Me.ListView1
With .ColumnHeaders
.Clear
.Add , , "xxxxxxxx", 138, lvwColumnLeft
.Add , , "xxxxxxx", 70, lvwColumnCenter
.Add , , "xxxxx", 73, lvwColumnCenter
.Add , , "xxxxx", 42, lvwColumnCenter
.Add , , "xxxxxxxxx", 138, lvwColumnCenter
.Add , , "xxxxxxx", 77, lvwColumnCenter
.Add , , "xxxxxxxx", 110, lvwColumnCenter
.Add , , "xxxxxxxxxxx", 115, lvwColumnCenter
.Add , , "xxxx", 30, lvwColumnCenter
.Add , , "xxxxx", 50, lvwColumnCenter
End With
ligne = 1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
End With
End Sub
Sub Majour_Lvw()
Dim Nbl As Long, I As Long, J As Long, c As Range
ListView1.ListItems.Clear
With Sheets("Feuil3")
I = 2
J = .Range("A456541").End(xlUp).Row
For Each c In .Range("A2:A" & .Range("A456541").End(xlUp).Row)
Call IniLvw_Maj(c.Row)
Next c
End With
End Sub
Sub IniLvw_Maj(a As Long)
Dim x
Dim I
Dim J
Dim c
With ListView1
.ListItems.Add , , Sheets("Feuil3").Cells(a, 1)
For I = 1 To 9
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Feuil3").Cells(a, I + 1)
Next
.ListItems(.ListItems.Count).ListSubItems.Add , , a
For I = 1 To .ListItems.Count
If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
For J = 1 To .ColumnHeaders.Count - 1
If .ListItems(I).ListSubItems(7).Text = "xxxxxxxx" Then
.ListItems(I).Bold = True
.ListItems(I).ForeColor = vbRed
For c = 1 To .ColumnHeaders.Count
.ListItems(I).ListSubItems(c).Bold = True
.ListItems(I).ListSubItems(c).ForeColor = vbRed
Next c
End If
Next J
Next I
End With
End Sub
Dans un de mes userform j'ai cet deux lignes
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
qui génére l'erreur "Type défini par l'utilisateur non défini" si vous avez une solution SVP merci
voici le code
Private Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Option Compare Text
Option Explicit
Dim Mem_Code_Art
Private Sub Ajouter_Click()
Dim derligne As Integer
If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
derligne = Sheets("Feuil3").Range("A456541").End(xlUp).Row + 1
Cells(derligne, 1) = TextBox12.Value
Cells(derligne, 2) = TextBox2.Value
Cells(derligne, 3) = TextBox3.Value
Cells(derligne, 4) = TextBox4.Value
Cells(derligne, 5) = TextBox5.Value
Cells(derligne, 6) = TextBox6.Value
Cells(derligne, 7) = TextBox7.Value
Cells(derligne, 8) = TextBox8.Value
Cells(derligne, 9) = TextBox9.Value
Cells(derligne, 10) = TextBox10.Value
Call Majour_Lvw
End If
End Sub
Private Sub CommandButton1_Click()
Unload Userform51
End Sub
Private Sub Majour_Lsvw_Click()
Call Majour_Lvw
End Sub
Private Sub Supprimer_Click()
Dim cel As Range, lig&, I&, rep, Nb
Nb = Application.CountIf(Columns(1), Mem_Code_Art)
If Nb > 0 Then
lig = 2
lig = Columns(1).Find(Mem_Code_Art, Cells(lig, 1), , xlWhole).Row
rep = MsgBox("ATTENTION Vous allez Supprimer la ligne, action Irréversible", vbCritical + vbYesNo, "Suppression")
If rep = vbNo Then Exit Sub
With Feuil3
.Rows(lig).Delete
End With
Call Majour_Lvw
Else
MsgBox " xxxxxxx n'existe pas !!!!!!!!!!!!!!!!!!!"
End If
End Sub
Private Sub Modifier_Click()
Dim Nb, lig As Long, ligLst As Long, J
If Me.ListView1.SelectedItem.Index > 0 Then
Nb = Application.CountIf(Columns(1), Mem_Code_Art)
If Nb > 0 Then
lig = 2
lig = Columns(1).Find(Mem_Code_Art, Cells(lig, 1), , xlWhole).Row
Cells(lig, 1) = TextBox12
TextBox12.Value = ""
For J = 2 To 10
Cells(lig, J).Value = Me.Controls("TextBox" & J)
Me.Controls("TextBox" & J) = ""
Next J
Call Majour_Lvw
End If
End If
End Sub
Private Sub TextBox8_Change()
If TextBox8 = "xxxxxxxx" Then
TextBox12.ForeColor = vbRed
TextBox2.ForeColor = vbRed
TextBox3.ForeColor = vbRed
TextBox4.ForeColor = vbRed
TextBox5.ForeColor = vbRed
TextBox6.ForeColor = vbRed
TextBox7.ForeColor = vbRed
TextBox8.ForeColor = vbRed
TextBox9.ForeColor = vbRed
TextBox10.ForeColor = vbRed
Else
TextBox12.ForeColor = vbBlack
TextBox2.ForeColor = vbBlack
TextBox3.ForeColor = vbBlack
TextBox4.ForeColor = vbBlack
TextBox5.ForeColor = vbBlack
TextBox6.ForeColor = vbBlack
TextBox7.ForeColor = vbBlack
TextBox8.ForeColor = vbBlack
TextBox9.ForeColor = vbBlack
TextBox10.ForeColor = vbBlack
End If
End Sub
Private Sub TextBox1_Change()
Dim I As Long
Dim c As Range
ListView1.ListItems.Clear
If TextBox1 <> "" Then
With Sheets("Feuil3")
I = 2
Do
For Each c In .Range(.Cells(I, 1), .Cells(I, 10))
If UCase(CStr(c.Value)) = UCase(TextBox1.Value) Or InStr(CStr(c), TextBox1) > 0 Then
IniLvw12 c.Row
Exit For
End If
Next c
I = I + 1
Loop While .Cells(I, 1) <> ""
End With
Else
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox6 = ""
Me.TextBox7 = ""
Me.TextBox8 = ""
Me.TextBox9 = ""
Me.TextBox10 = ""
Me.TextBox12 = ""
Call Majour_Lvw
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.Sorted = False
ListView1.SortKey = ColumnHeader.Index - 1
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else
ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim I As Integer
Dim J As Integer
Dim x
I = Me.ListView1.SelectedItem.Index
TextBox12 = ListView1.ListItems(I)
Mem_Code_Art = TextBox12.Value
For J = 1 To Me.ListView1.ColumnHeaders.Count - 1
Me.Controls("Textbox" & J + 1) = ListView1.ListItems(I).ListSubItems(J).Text
Next J
End Sub
Sub IniLvw12(a As Long)
Dim x
Dim I
Dim J
Dim c
With ListView1
.ListItems.Add , , Sheets("Feuil3").Cells(a, 1)
For I = 1 To 9
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Feuil3").Cells(a, I + 1)
Next
.ListItems(.ListItems.Count).ListSubItems.Add , , a
For I = 1 To .ListItems.Count
If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
For J = 1 To .ColumnHeaders.Count - 1
If .ListItems(I).ListSubItems(7).Text = "xxxxxxxx" Then
.ListItems(I).Bold = True
.ListItems(I).ForeColor = vbRed
For c = 1 To .ColumnHeaders.Count
.ListItems(I).ListSubItems(c).Bold = True
.ListItems(I).ListSubItems(c).ForeColor = vbRed
Next c
End If
Next J
Next I
End With
End Sub
Private Sub UserForm_Activate()
EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
End Sub
Private Sub UserForm_Initialize()
Dim hWnd As Long
Dim ligne
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
With Me.ListView1
With .ColumnHeaders
.Clear
.Add , , "xxxxxxxx", 138, lvwColumnLeft
.Add , , "xxxxxxx", 70, lvwColumnCenter
.Add , , "xxxxx", 73, lvwColumnCenter
.Add , , "xxxxx", 42, lvwColumnCenter
.Add , , "xxxxxxxxx", 138, lvwColumnCenter
.Add , , "xxxxxxx", 77, lvwColumnCenter
.Add , , "xxxxxxxx", 110, lvwColumnCenter
.Add , , "xxxxxxxxxxx", 115, lvwColumnCenter
.Add , , "xxxx", 30, lvwColumnCenter
.Add , , "xxxxx", 50, lvwColumnCenter
End With
ligne = 1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
End With
End Sub
Sub Majour_Lvw()
Dim Nbl As Long, I As Long, J As Long, c As Range
ListView1.ListItems.Clear
With Sheets("Feuil3")
I = 2
J = .Range("A456541").End(xlUp).Row
For Each c In .Range("A2:A" & .Range("A456541").End(xlUp).Row)
Call IniLvw_Maj(c.Row)
Next c
End With
End Sub
Sub IniLvw_Maj(a As Long)
Dim x
Dim I
Dim J
Dim c
With ListView1
.ListItems.Add , , Sheets("Feuil3").Cells(a, 1)
For I = 1 To 9
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Feuil3").Cells(a, I + 1)
Next
.ListItems(.ListItems.Count).ListSubItems.Add , , a
For I = 1 To .ListItems.Count
If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
For J = 1 To .ColumnHeaders.Count - 1
If .ListItems(I).ListSubItems(7).Text = "xxxxxxxx" Then
.ListItems(I).Bold = True
.ListItems(I).ForeColor = vbRed
For c = 1 To .ColumnHeaders.Count
.ListItems(I).ListSubItems(c).Bold = True
.ListItems(I).ListSubItems(c).ForeColor = vbRed
Next c
End If
Next J
Next I
End With
End Sub