Public Sel As Variant, Flag As Boolean, FlagMdP As Boolean 'variables à ne surtout pas supprimer !!
Option Explicit
Dim WS As Worksheet
Dim LST As ListObject
Dim Y As Byte, X As Byte
Dim NbCol, NbLig
Dim Largeur
Dim Cel As Range
Public Col As Integer
Dim ligne
Private Sub CONTROLEDONNEES_Click()
MacroX
CODEBASE
DATEGOOGLEAGENDA
LIENHYPERTEXTEMODIF
IniListview
End Sub
Private Sub INITIALISATION_Click()
IniListview
Défiltrage
COMMENTAIRESPOSTES.Value = ""
End Sub
Private Sub RETOUREXCEL_Click()
Unload GENERAL
End Sub
Private Sub UserForm_Initialize()
Dim Cel As Range 'Déclaration de la Variable Cel
Dim i As Byte, j As Byte
Dim tablo As New Collection 'déclare la variable tablo
Dim item As Variant 'déclare la variable item
Dim strTemp
IniListview
'***********************************************************************
'remplissage sans doublons de la ComboBox1 en passant par une Collection
'***********************************************************************
On Error Resume Next 'gestion des erreurs
'Boucle sut toutes les cel de la plage
'ajoute un membre (la valeur de la cellule cel convertie en texte) a la collection
'un doublon provoque une erreur
For Each Cel In LST.DataBodyRange.Columns(42).Cells
tablo.Add CStr(Cel.Value), CStr(Cel.Value)
Next Cel
For Each item In tablo 'boucle sur tous les membres de la collection "tablo"
Me.COMMENTAIRESPOSTES.AddItem tablo(item)
Next item 'prochain membre de la collection
'Remplissage du Combobox avec la Colonne N°42
With Me.COMMENTAIRESPOSTES
For i = 0 To .ListCount - 1
For j = 0 To .ListCount - 1
If .List(i) < .List(j) Then
strTemp = .List(i)
.List(i) = .List(j)
.List(j) = strTemp
End If
Next j
Next i
End With
End Sub
Private Sub IniListview()
Set WS = Worksheets("BASE EMPLOI")
Set LST = WS.ListObjects("TABLEAU1")
NbCol = LST.HeaderRowRange.Columns.Cells.Count
With Me.LISTBDD
.Gridlines = True
.HideColumnHeaders = False
.View = lvwReport
.ListItems.Clear
.ColumnHeaders.Clear
'REMPLISSAGE DES ENTETES "HEADERS"
With .ColumnHeaders
For Y = 1 To NbCol 'OK pour numérotation des Colonnes
For Each Cel In LST.HeaderRowRange.Columns(Y).Cells
Largeur = LST.DataBodyRange.Columns(Y).Width * 1.1
.Add , , Cel, Largeur 'ici valeur Texte des Entêtes de colonnes
'.Add , , y, Largeur 'Ok garder ce code pour N° Col enlever au-dessus
Next Cel
Next Y
End With
'Données Colonne 1 du "Tableau1" sans Entêtes et Totaux
For Each Cel In LST.DataBodyRange.Columns(1).Cells
.ListItems.Add , , Cel.Text 'Text pour reprendre le Format
X = .ListItems.Count
For Col = 1 To NbCol - 1
' .ListItems(Ligne).ListSubItems.Add , , cel.Offset(, Col)
.ListItems(X).ListSubItems.Add , , Cel.Offset(, Col).Text
' .ListSubItems(NbCol - 1).ForeColor = cel.Offset(0, NbCol - 1).Font.Color
.ListItems(X).ListSubItems(Col).ForeColor = Cel.Offset(, Col).Font.Color
'.ListItems(X).ListSubItems(Col).TooltipText = cel.Offset(, Col).AddComment
Next Col
Next Cel
MsgBox "Ce " & LST.Name & " comporte : " & Chr(10) & Chr(10) & _
"Colonnes : " & NbCol & Chr(10) & _
"Lignes : " & LST.DataBodyRange.Rows.Count & " ( Sans Totaux ) " & Chr(10) & _
"Lignes : " & LST.DataBodyRange.Rows.Count + 1 & " ( Avec Totaux )" & Chr(10) & _
"Cellules : " & LST.DataBodyRange.Count & " ( Sans Totaux ) " & Chr(10) & _
"Cellules : " & LST.DataBodyRange.Resize(NbLig + 1, NbCol).Count & " ( Avec Totaux ) " & Chr(10) & Chr(10) & _
_
"Cette : " & Me.LISTBDD.Name & " comporte :" & Chr(10) & Chr(10) & _
"Colonnes : " & Me.LISTBDD.ColumnHeaders.Count & Chr(10) & _
"Lignes : " & Me.LISTBDD.ListItems.Count & Chr(10) & _
"Cellules : " & (.ListItems.Count - 1) * .ColumnHeaders.Count & " ( Sans Totaux ) " & Chr(10) & _
"Cellules : " & .ListItems.Count * .ColumnHeaders.Count & " ( Avec Totaux ) "
End With
Me.Caption = "Nombres d'enregistrements : " & LST.DataBodyRange.Rows.Count
End Sub
Private Sub LISTBDD_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
LISTBDD.Sorted = False
LISTBDD.SortKey = ColumnHeader.Index - 1
If LISTBDD.SortOrder = lvwAscending Then
LISTBDD.SortOrder = lvwDescending
Else
LISTBDD.SortOrder = lvwAscending
End If
LISTBDD.Sorted = True
End Sub
Private Sub FILTRER_Click()
Dim Plage As Range
Dim Cel
Dim Cel2
'IniListview
LISTBDD.ListItems.Clear
LISTBDD.ColumnHeaders.Clear
With Sheets("BASE EMPLOI")
.AutoFilterMode = False
.ListObjects("Tableau1").Range.AutoFilter Field:=42, Criteria1:=Me.COMMENTAIRESPOSTES.Value
'With .AutoFilter.Range
'Set Plage = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
'For Each Cel In Plage
With LISTBDD
With .ColumnHeaders
.Add , , LST.HeaderRowRange.Cells(1, 1).Text, LST.HeaderRowRange.Cells(1, 1).Width * 1.1
For Y = 42 To NbCol 'OK pour numérotation des Colonnes
Largeur = LST.DataBodyRange.Columns(Y).Width * 1.1
For Each Cel2 In LST.HeaderRowRange.Columns(Y).Cells
'Largeur = LST.DataBodyRange.Columns(Y).Width * 1.1
.Add , , Cel2, Largeur 'ici valeur Texte des Entêtes de colonnes
'.Add , , y, Largeur 'Ok garder ce code pour N° Col enlever au-dessus
Next Cel2
Next Y
End With
For Each Cel In LST.DataBodyRange.SpecialCells(xlCellTypeVisible).Columns(1).Cells
.ListItems.Add , , Cel
For Y = 41 To NbCol
.ListItems(.ListItems.Count).ListSubItems.Add , , Cel.Offset(0, Y)
Next Y
Next Cel
End With
End With
End Sub
Sub LISTBDD_DblClick()
'Cette macro se déclenche uniquement sur DoubleClick de ta Listbox
Dim CodeBaseValue As Variant 'Je ne sais pas ce qu'il y a dans ta base, dans le doute, Variant
'S'il ya un double clique sur une item
'A- Je récupére la valeur CODEBASE correspondante à la ligne cliquer
With LISTBDD
CodeBaseValue = .List(.ListIndex, 1) 'X correspond au numéro de colonne dont tu veux l'information
End With
'Tu récupere la valeur sur laquelle tu as double Click
'B-Puis je lance l'userform GESTIONPOSTE en remplissant tout les textbox en faisant une recherche verticale dans l'onglet BASE EMPLOI sur la valeur CODEBASE mise en mémoire.'
Me.Hide
Load GESTIONPOSTE
With GESTIONPOSTE
CODEBASE.Value = CodeBaseValue
'Do some stuff
End With
GESTIONPOSTE.Show
End Sub
'On remplit la listbox ou la combobox LST par les données de la colonne COL
Private Sub Remplir(ByVal LST As Object, ByVal Col As Integer)
Dim MonDico As Object
Dim f As Worksheet
Dim C As Range
Dim temp()
Set MonDico = CreateObject("Scripting.Dictionary")
Set f = Worksheets("BASE EMPLOI")
With f
For Each C In .Range(.Cells(2, Col), .Cells(.Rows.Count, Col).End(xlUp))
If C.Value <> "" Then MonDico.item(C.Value) = C.Value
Next C
End With
Set f = Nothing
temp = MonDico.Items
Set MonDico = Nothing
Call Tri(temp, LBound(temp), UBound(temp))
LST.List = temp
End Sub
Private Sub Tri(a(), ByVal gauc As Long, ByVal droi As Long) ' Quick sort
Dim G As Long, d As Long
Dim Ref, temp
Ref = a((gauc + droi) \ 2)
G = gauc: d = droi
Do
Do While a(G) < Ref: G = G + 1: Loop
Do While Ref < a(d): d = d - 1: Loop
If G <= d Then
temp = a(G): a(G) = a(d): a(d) = temp
G = G + 1: d = d - 1
End If
Loop While G <= d
If G < droi Then Call Tri(a, G, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
