Réduire le nombre de listView
p
Bonjour,
j'aimerai réduire le nombre de List View de Mon fichier à une seule pour permettre de réduire la taille de mes codes. est ce que quelqu'un aurai une solution.:
Option Explicit
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Sub CommandButton6_Click() 'IMPRIMER CA
Dim I As Integer
Sheets("CA").Activate
Application.ScreenUpdating = False 'Empéche la mise à jour de l'affichage écran durant la procédure pour gagner du temps
With Sheets("CA")
.Range("Tableau1").ClearContents
.ListObjects("Tableau1").Resize .Range("A1:M1").Resize(Me.ListView1.ListItems.Count + 1)
For I = 1 To Me.ListView1.ListItems.Count
.Range("A" & I + 1).Value = Me.ListView1.ListItems(I).Text
.Range("B" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(1).Text
.Range("C" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(2).Text
.Range("D" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(3).Text
.Range("E" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(4).Text
.Range("F" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(5).Text
.Range("G" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(6).Text
.Range("H" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(7).Text
.Range("I" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(8).Text
.Range("J" & I + 1).Value = Me.ListView1.ListItems(I).ListSubItems(12).Text
Next I
'.Columns("A:J").AutoFit 'Ajuste la largeur de chaque colonnes selon la largeur du contenu
Me.Hide
.PrintPreview
'.PrintOut 'Imprime la feuille
End With
' Application.ScreenUpdating = True
Me.Show
End Sub
Private Sub CommandButton7_Click() 'IMPRIMER RTT
Dim I As Integer
Sheets("RTT").Activate
Application.ScreenUpdating = False 'Empéche la mise à jour de l'affichage écran durant la procédure pour gagner du temps
With Sheets("RTT")
.Range("Tableau2").ClearContents
.ListObjects("Tableau2").Resize .Range("A1:M1").Resize(Me.ListView2.ListItems.Count + 1)
For I = 1 To Me.ListView2.ListItems.Count
.Range("A" & I + 1).Value = Me.ListView2.ListItems(I).Text
.Range("B" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(1).Text
.Range("C" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(2).Text
.Range("D" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(3).Text
.Range("E" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(4).Text
.Range("F" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(5).Text
.Range("G" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(6).Text
.Range("H" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(7).Text
.Range("I" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(8).Text
.Range("J" & I + 1).Value = Me.ListView2.ListItems(I).ListSubItems(12).Text
Next I
'.Columns("A:J").AutoFit 'Ajuste la largeur de chaque colonnes selon la largeur du contenu
Me.Hide
.PrintPreview
'.PrintOut 'Imprime la feuille
End With
' Application.ScreenUpdating = True
Me.Show
End Sub
Private Sub CommandButton8_Click() 'IMPRIMER RELIQUAT N-1
Dim I As Integer
Sheets("RELIQUAT N-1").Activate
Application.ScreenUpdating = False 'Empéche la mise à jour de l'affichage écran durant la procédure pour gagner du temps
With Sheets("RELIQUAT N-1")
.Range("Tableau3").ClearContents
.ListObjects("Tableau3").Resize .Range("A1:M1").Resize(Me.ListView3.ListItems.Count + 1)
For I = 1 To Me.ListView3.ListItems.Count
.Range("A" & I + 1).Value = Me.ListView3.ListItems(I).Text
.Range("B" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(1).Text
.Range("C" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(2).Text
.Range("D" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(3).Text
.Range("E" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(4).Text
.Range("F" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(5).Text
.Range("G" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(6).Text
.Range("H" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(7).Text
.Range("I" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(8).Text
.Range("J" & I + 1).Value = Me.ListView3.ListItems(I).ListSubItems(12).Text
Next I
'.Columns("A:J").AutoFit 'Ajuste la largeur de chaque colonnes selon la largeur du contenu
Me.Hide
.PrintPreview
'.PrintOut 'Imprime la feuille
End With
' Application.ScreenUpdating = True
Me.Show
End Sub
Private Sub CommandButton9_Click()
Dim I As Integer
Sheets("Heures supplémentaires").Activate
Application.ScreenUpdating = False 'Empéche la mise à jour de l'affichage écran durant la procédure pour gagner du temps
With Sheets("Heures supplémentaires")
.Range("Tableau5").ClearContents
.ListObjects("Tableau5").Resize .Range("A1:M1").Resize(Me.ListView4.ListItems.Count + 1)
For I = 1 To Me.ListView4.ListItems.Count
.Range("A" & I + 1).Value = Me.ListView4.ListItems(I).Text
.Range("B" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(1).Text
.Range("C" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(2).Text
.Range("D" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(3).Text
.Range("E" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(4).Text
.Range("F" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(5).Text
.Range("G" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(6).Text
.Range("H" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(7).Text
.Range("I" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(8).Text
.Range("J" & I + 1).Value = Me.ListView4.ListItems(I).ListSubItems(12).Text
Next I
'.Columns("A:J").AutoFit 'Ajuste la largeur de chaque colonnes selon la largeur du contenu
Me.Hide
.PrintPreview
'.PrintOut 'Imprime la feuille
End With
' Application.ScreenUpdating = True
Me.Show
End Sub
Private Sub Label8_Click()
End Sub
Private Sub TextBox12_Change()
Call LVW_Fill(Me.TextBox12.Text, 0)
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub UserForm_Initialize()
Me.TextBox13 = Sheets("Feuil1").Range("B1") 'Identifiant connecté
Me.TextBox1 = Now 'date et heure
Me.TextBox12.Value = Trouve.Offset(0, 1).Value
Me.DTPicker1 = Date
Me.DTPicker2 = Date
'Dim MyImage As String
'Dim MyImage2 As String
'Dim Chemin As String
'Chemin = ThisWorkbook.Path & "\"
'
'MyImage = TextBox12.Value
'Image1.Picture = LoadPicture(Chemin & MyImage & ".jpg")
'Image1.PictureSizeMode = 1
'
'MyImage2 = TextBox13.Value
'Image2.Picture = LoadPicture(Chemin & MyImage2 & ".jpg")
'Image2.PictureSizeMode = 1
'********************************CA***************************
Dim fin&, I&, j&
With ListView1
With .ColumnHeaders
.Clear
.Add , , "Date", 80
.Add , , "Nombre de CA sur Jours Travaillés", 150
.Add , , "Nombre de CA sur RC", 100
.Add , , "Période", 100
.Add , , "Signature Agent", 50
.Add , , "Accord", 30
.Add , , "Refus", 30
.Add , , "Date", 30
.Add , , "Observation", 150
End With
End With
fin = Feuil88.Range("A" & Rows.Count).End(xlUp).Row
With ListView1
For I = 2 To fin
.ListItems.Add , , Feuil88.Cells(I, 1)
For j = 2 To 6
.ListItems(.ListItems.Count).ListSubItems.Add , , Feuil88.Cells(I, j)
Next j
Next I
End With
ListView1.View = lvwReport
ListView1.Gridlines = True
ListView1.AllowColumnReorder = True
ListView1.FullRowSelect = True
'*******************************RTT***********************************
Dim pas&, k&, M&
With ListView2
With .ColumnHeaders
.Clear
.Add , , "Date", 80
.Add , , "Nombre de RTT sur Jours Travaillés", 150
.Add , , "Nombre de RTT sur RC", 100
.Add , , "Période", 100
.Add , , "Signature Agent", 50
.Add , , "Accord", 30
.Add , , "Refus", 30
.Add , , "Date", 30
.Add , , "Observation", 150
End With
End With
pas = Feuil89.Range("A" & Rows.Count).End(xlUp).Row
With ListView2
For k = 2 To fin
.ListItems.Add , , Feuil89.Cells(k, 1)
For M = 2 To 6
.ListItems(.ListItems.Count).ListSubItems.Add , , Feuil89.Cells(k, M)
Next M
Next k
End With
ListView2.View = lvwReport
ListView2.Gridlines = True
ListView2.AllowColumnReorder = True
ListView2.FullRowSelect = True
'************************************Reliquat n-1*****************************
Dim pi&, n&, O&
With ListView3
With .ColumnHeaders
.Clear
.Add , , "Date", 80
.Add , , "Nombre de RTT sur Jours Travaillés", 150
.Add , , "Nombre de RTT sur RC", 100
.Add , , "Période", 100
.Add , , "Signature Agent", 50
.Add , , "Accord", 30
.Add , , "Refus", 30
.Add , , "Date", 30
.Add , , "Observation", 150
End With
End With
pi = Feuil90.Range("A" & Rows.Count).End(xlUp).Row
With ListView3
For n = 2 To fin
.ListItems.Add , , Feuil90.Cells(n, 1)
For O = 2 To 6
.ListItems(.ListItems.Count).ListSubItems.Add , , Feuil90.Cells(n, O)
Next O
Next n
End With
ListView3.View = lvwReport
ListView3.Gridlines = True
ListView3.AllowColumnReorder = True
ListView3.FullRowSelect = True
'
'******************************Heures supplémentaire******************************
Dim pio&, p&, q&
With ListView4
With .ColumnHeaders
.Clear
.Add , , "Date", 80
.Add , , "Nombre de RTT sur Jours Travaillés", 150
.Add , , "Nombre de RTT sur RC", 100
.Add , , "Période", 100
.Add , , "Signature Agent", 50
.Add , , "Accord", 30
.Add , , "Refus", 30
.Add , , "Date", 30
.Add , , "Observation", 150
End With
End With
pio = Feuil91.Range("A" & Rows.Count).End(xlUp).Row
With ListView4
For p = 2 To fin
.ListItems.Add , , Feuil91.Cells(p, 1)
For q = 2 To 6
.ListItems(.ListItems.Count).ListSubItems.Add , , Feuil91.Cells(p, q)
Next q
Next p
End With
ListView4.View = lvwReport
ListView4.Gridlines = True
ListView4.AllowColumnReorder = True
ListView4.FullRowSelect = True
End Sub
Private Sub CommandButton2_Click() 'CA
Dim r As Integer
r = Sheets("CA").Range("a65536").End(xlUp).Row + 1
Sheets("CA").Range("A" & r).Value = TextBox12 'Nom
Sheets("CA").Range("B" & r).Value = TextBox1 'Date et heure de la demande
Sheets("CA").Range("C" & r).Value = TextBox8 'Nombre de CA sur Jours Travaillés
Sheets("CA").Range("D" & r).Value = TextBox7 'Nombre de CA sur RC
Sheets("CA").Range("E" & r).Value = DTPicker1 & " " & "au" & " " & DTPicker2 'Période
Unload UserForm4
UserForm4.Show
End Sub
Private Sub CommandButton1_Click() 'RELIQUAT N-1
Dim V As Integer
V = Sheets("RELIQUAT N-1").Range("a65536").End(xlUp).Row + 1
Sheets("RELIQUAT N-1").Range("A" & V).Value = TextBox12 'Nom
Sheets("RELIQUAT N-1").Range("B" & V).Value = TextBox1 'Date et heure de la demande
Sheets("RELIQUAT N-1").Range("C" & V).Value = TextBox5 'Nombre de CA sur Jours Travaillés
Sheets("RELIQUAT N-1").Range("D" & V).Value = TextBox6 'Nombre de CA sur RC
Sheets("RELIQUAT N-1").Range("E" & V).Value = DTPicker1 & " " & "au" & " " & DTPicker2 'Période
Unload UserForm4
UserForm4.Show
End Sub
Private Sub CommandButton3_Click() 'RTT
Dim t As Integer
t = Sheets("RTT").Range("a65536").End(xlUp).Row + 1
Sheets("RTT").Range("A" & t).Value = TextBox12 'Nom
Sheets("RTT").Range("B" & t).Value = TextBox1 'Date et heure de la demande
Sheets("RTT").Range("C" & t).Value = TextBox10 'Nombre de CA sur Jours Travaillés
Sheets("RTT").Range("D" & t).Value = TextBox9 'Nombre de CA sur RC
Sheets("RTT").Range("E" & t).Value = DTPicker1 & " " & "au" & " " & DTPicker2 'Période
Unload UserForm4
UserForm4.Show
End Sub
Private Sub CommandButton4_Click() 'HEURES SUPPLEMENTAIRE
Dim u As Integer
u = Sheets("Heures supplémentaires").Range("a65536").End(xlUp).Row + 1
Sheets("Heures supplémentaires").Range("A" & u).Value = TextBox12 'Nom
Sheets("Heures supplémentaires").Range("B" & u).Value = TextBox1 'Date et heure de la demande
Sheets("Heures supplémentaires").Range("C" & u).Value = TextBox14 'Nombre de CA sur Jours Travaillés
Sheets("Heures supplémentaires").Range("D" & u).Value = TextBox16 'Nombre de CA sur RC
Sheets("Heures supplémentaires").Range("E" & u).Value = DTPicker1 & " " & "au" & " " & DTPicker2 'Période
Unload UserForm4
UserForm4.Show
End Sub
Private Sub CommandButton5_Click()
Dim d1 As Date, d2 As Date
d1 = DTPicker1 ' Date de début
d2 = DTPicker2 ' date de fin
TextBox11 = NbJoursOuvres(d1, d2)
End Sub
Private Sub UserForm_Activate()
Call LVW_Fill(Me.TextBox12.Text, 0)
End Sub
Private Sub LVW_Fill(ByVal sFilter As String, ByVal iCol As Integer)
'Variables locales
Dim iCnt As Integer
Dim iRnd As Integer
Dim oRng As Excel.Range
Dim oItem As ListItem
'******************************CA***************************************
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
'Remplissage de la ListView
Set oRng = Sheets("CA").Cells(, 1)
Do Until oRng.Offset(0, 0).Value = ""
'-- En-têtes
If oRng.Row = 1 Then
For iCnt = 0 To 13
If iCnt = 0 Then
ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 80
ElseIf iCnt = 1 Then
ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
ElseIf iCnt = 4 Then
ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 140
Else
ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
End If
Next iCnt
'-- Données
Else
' iRnd = Int((4 * Rnd) + 1) ?????
If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
Set oItem = ListView1.ListItems.Add(, , oRng.Offset(0, 0)) ', "Key" & iRnd, "Key" & iRnd)
For iCnt = 1 To 13 '-- 13 colonnes
oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
Next iCnt
End If
End If
Set oRng = oRng.Offset(1, 0)
Loop
'******************************RTT***************************************
ListView2.ColumnHeaders.Clear
ListView2.ListItems.Clear
'Remplissage de la ListView
Set oRng = Sheets("RTT").Cells(, 1)
Do Until oRng.Offset(0, 0).Value = ""
'-- En-têtes
If oRng.Row = 1 Then
For iCnt = 0 To 13
If iCnt = 0 Then
ListView2.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 80
ElseIf iCnt = 1 Then
ListView2.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
ElseIf iCnt = 4 Then
ListView2.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 140
Else
ListView2.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
End If
Next iCnt
'-- Données
Else
' iRnd = Int((4 * Rnd) + 1) ?????
If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
Set oItem = ListView2.ListItems.Add(, , oRng.Offset(0, 0)) ', "Key" & iRnd, "Key" & iRnd)
For iCnt = 1 To 13 '-- 13 colonnes
oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
Next iCnt
End If
End If
Set oRng = oRng.Offset(1, 0)
Loop
'******************************RELIQUAT N-1***************************************
ListView3.ColumnHeaders.Clear
ListView3.ListItems.Clear
'Remplissage de la ListView
Set oRng = Sheets("RELIQUAT N-1").Cells(, 1)
Do Until oRng.Offset(0, 0).Value = ""
'-- En-têtes
If oRng.Row = 1 Then
For iCnt = 0 To 13
If iCnt = 0 Then
ListView3.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 80
ElseIf iCnt = 1 Then
ListView3.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
ElseIf iCnt = 4 Then
ListView3.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 140
Else
ListView3.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
End If
Next iCnt
'-- Données
Else
' iRnd = Int((4 * Rnd) + 1) ?????
If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
Set oItem = ListView3.ListItems.Add(, , oRng.Offset(0, 0)) ', "Key" & iRnd, "Key" & iRnd)
For iCnt = 1 To 13 '-- 13 colonnes
oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
Next iCnt
End If
End If
Set oRng = oRng.Offset(1, 0)
Loop
'******************************HEURES SUPPLEMENTAIRES*************************************
ListView4.ColumnHeaders.Clear
ListView4.ListItems.Clear
'Remplissage de la ListView
Set oRng = Sheets("Heures supplémentaires").Cells(, 1)
Do Until oRng.Offset(0, 0).Value = ""
'-- En-têtes
If oRng.Row = 1 Then
For iCnt = 0 To 13
If iCnt = 0 Then
ListView4.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 80
ElseIf iCnt = 1 Then
ListView4.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
ElseIf iCnt = 4 Then
ListView4.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 140
Else
ListView4.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 40
End If
Next iCnt
'-- Données
Else
' iRnd = Int((4 * Rnd) + 1) ?????
If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
Set oItem = ListView4.ListItems.Add(, , oRng.Offset(0, 0)) ', "Key" & iRnd, "Key" & iRnd)
For iCnt = 1 To 13 '-- 13 colonnes
oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
Next iCnt
End If
End If
Set oRng = oRng.Offset(1, 0)
Loop
End SubPS: Identifiant: ADMIN
Mots de passe : ADMIN