Code VBA qui fonctionnent après plus de cinq minutes
Bonsoir
J' ai cet ensemble de code VBA qui fonctionnait bien mais à présent si je veux ajouter un nom ou faire une recherche il se passe plus de cinq minutes...
Je ne vois vraiment ce qui peut freiner à ce point l'opération.
Ci dessous les codes .
Cdt
'AJOUTER
Private Sub BtnAJOUTER_Click()
Application.ScreenUpdating = False
If CboNOM.Value = "" Then
MsgBox "Veuillez renseigner le champs 'Nom' "
Else
'Dim ligne As Integer
If MsgBox("confirmez l'ajout de données ?", vbYesNo, "confirmation") = vbYes Then
Sheets("ST").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
MsgBox "Fonctionnaire bien enregsitré", vbOKOnly + vbInformation, "CONFIRMATION"
'
' TRIHA Macro
'
'
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SECTION]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
'TRI Macro
'
'Sheets("Séances de tirs").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
End If
End If
End Sub
'EFFACER
Private Sub BtnEFFACER_Click()
CboSECTION = ""
CboSER = ""
CboGRA = ""
CboNOM = ""
TxtPRENOM = ""
End Sub
'MODIFIER
Private Sub BtnModifier_Click()
Dim modif As Integer
Application.ScreenUpdating = False
'Modif sur feuille habilitation
Sheets("HA").Select
No_ligne = CboNOM.ListIndex + 39
If TxtPRENOM.Value = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
'Modif sur feuille séance de tirs
Sheets("ST").Select
No_ligne = CboNOM.ListIndex + 39
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
Sheets("ST").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
MsgBox ("Modification effectuée")
Unload UserForm4
Load UserForm4
UserForm4.Show
End If
End Sub
'QUITTER le formulaire
Private Sub BtnQuitter_Click()
Unload Me
Sheets("sommaire").Select
End Sub
'RECHERCHER
Private Sub BtnRechercher_Click()
Sheets("HA").Activate
'If CboNom.Value = "" Then
'MsgBox ("Veuillez entrer le nom du fonctionnaire")
If Not CboNOM.Value = "" Then
Dim No_ligne As Integer
No_ligne = CboNOM.ListIndex + 39
CboSEC.Value = Cells(No_ligne, 1).Value
CboSER.Value = Cells(No_ligne, 2).Value
CboGRA.Value = Cells(No_ligne, 4).Value
TxtPRENOM.Value = Cells(No_ligne, 6).Value
Else
End If
'End If
End Sub
'SUPPRIMER UNE LIGNE
Private Sub BtnSUPPRIMER_Click()
If MsgBox("Etes vous sûr de supprimer cette ligne ?", vbYesNo, "Demande de suppression") = vbYes Then
Sheets("HA").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Sheets("ST").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Unload Me
End If
End Sub
'EVITER LA REPRISE DU NOM
Private Sub CboNom_Change()
CboNOM.MatchEntry = fmMatchEntryNone
'NOM en MAJUSCULE
CboNOM = UCase(CboNOM)
End Sub
'Bloquage bouton AJOUTER
Private Sub TxtPrenom_Change()
If TxtPRENOM <> "" Then
BtnAJOUTER.Enabled = True
Else
BtnAJOUTER.Enabled = False
End If
TxtPRENOM = WorksheetFunction.Proper(TxtPRENOM)
End Sub
Private Sub UserForm_Activate()
TxtPRENOM.Value = ""
CboNOM.Value = ""
End Sub
Bonjour,
Il faut absolument utiliser les balises Code ...
Bonjour,
Mon dieu.. Ce code est illisible!
Yann
[code][/
'AJOUTER
Private Sub BtnAJOUTER_Click()
Application.ScreenUpdating = False
If CboNOM.Value = "" Then
MsgBox "Veuillez renseigner le champs 'Nom' "
Else
'Dim ligne As Integer
If MsgBox("confirmez l'ajout de données ?", vbYesNo, "confirmation") = vbYes Then
Sheets("ST").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
MsgBox "Fonctionnaire bien enregsitré", vbOKOnly + vbInformation, "CONFIRMATION"
'
' TRIHA Macro
'
'
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SECTION]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
'TRI Macro
'
'Sheets("Séances de tirs").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
End If
End If
End Sub
'EFFACER
Private Sub BtnEFFACER_Click()
CboSECTION = ""
CboSER = ""
CboGRA = ""
CboNOM = ""
TxtPRENOM = ""
End Sub
'MODIFIER
Private Sub BtnModifier_Click()
Dim modif As Integer
Application.ScreenUpdating = False
'Modif sur feuille habilitation
Sheets("HA").Select
No_ligne = CboNOM.ListIndex + 39
If TxtPRENOM.Value = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
'Modif sur feuille séance de tirs
Sheets("ST").Select
No_ligne = CboNOM.ListIndex + 39
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
Sheets("ST").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
MsgBox ("Modification effectuée")
Unload UserForm4
Load UserForm4
UserForm4.Show
End If
End Sub
'QUITTER le formulaire
Private Sub BtnQuitter_Click()
Unload Me
Sheets("sommaire").Select
End Sub
'RECHERCHER
Private Sub BtnRechercher_Click()
Sheets("HA").Activate
'If CboNom.Value = "" Then
'MsgBox ("Veuillez entrer le nom du fonctionnaire")
If Not CboNOM.Value = "" Then
Dim No_ligne As Integer
No_ligne = CboNOM.ListIndex + 39
CboSEC.Value = Cells(No_ligne, 1).Value
CboSER.Value = Cells(No_ligne, 2).Value
CboGRA.Value = Cells(No_ligne, 4).Value
TxtPRENOM.Value = Cells(No_ligne, 6).Value
Else
End If
'End If
End Sub
'SUPPRIMER UNE LIGNE
Private Sub BtnSUPPRIMER_Click()
If MsgBox("Etes vous sûr de supprimer cette ligne ?", vbYesNo, "Demande de suppression") = vbYes Then
Sheets("HA").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Sheets("ST").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Unload Me
End If
End Sub
'EVITER LA REPRISE DU NOM
Private Sub CboNom_Change()
CboNOM.MatchEntry = fmMatchEntryNone
'NOM en MAJUSCULE
CboNOM = UCase(CboNOM)
End Sub
'Bloquage bouton AJOUTER
Private Sub TxtPrenom_Change()
If TxtPRENOM <> "" Then
BtnAJOUTER.Enabled = True
Else
BtnAJOUTER.Enabled = False
End If
TxtPRENOM = WorksheetFunction.Proper(TxtPRENOM)
End Sub
Private Sub UserForm_Activate()
TxtPRENOM.Value = ""
CboNOM.Value = ""
End Sub
aucun avatar Tacentaure
Jeune membre
Jeune membre
Messages : 36
Inscription : 4 Octobre 2014
Version Excel : 2007
]
Le bon vieux copier coller intégral! Avatar compris
Je me permet de mettre ton code entre balise, ça aidera les membres qui voudront t'aider!
Aucune trace de fichier pour contextualiser tes macros par contre.. Et aucune explication du rôle de ces macros... :/
'AJOUTER
Private Sub BtnAJOUTER_Click()
Application.ScreenUpdating = False
If CboNOM.Value = "" Then
MsgBox "Veuillez renseigner le champs 'Nom' "
Else
'Dim ligne As Integer
If MsgBox("confirmez l'ajout de données ?", vbYesNo, "confirmation") = vbYes Then
Sheets("ST").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Activate
Range("A39").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell = CboSEC.Value
ActiveCell.Offset(0, 1).Value = CboSER
ActiveCell.Offset(0, 3).Value = CboGRA
ActiveCell.Offset(0, 4).Value = CboNOM
ActiveCell.Offset(0, 5).Value = TxtPRENOM
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
MsgBox "Fonctionnaire bien enregsitré", vbOKOnly + vbInformation, "CONFIRMATION"
'
' TRIHA Macro
'
'
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SECTION]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
'TRI Macro
'
'Sheets("Séances de tirs").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
End If
End If
End Sub
'EFFACER
Private Sub BtnEFFACER_Click()
CboSECTION = ""
CboSER = ""
CboGRA = ""
CboNOM = ""
TxtPRENOM = ""
End Sub
'MODIFIER
Private Sub BtnModifier_Click()
Dim modif As Integer
Application.ScreenUpdating = False
'Modif sur feuille habilitation
Sheets("HA").Select
No_ligne = CboNOM.ListIndex + 39
If TxtPRENOM.Value = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
Dim a As String
Dim b As String
Dim c As String
Dim LiFin(2) As Long
Dim x As Long
Dim y As Long
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 39).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 39)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
'Modif sur feuille séance de tirs
Sheets("ST").Select
No_ligne = CboNOM.ListIndex + 39
Cells(No_ligne, 1) = CboSEC.Value
Cells(No_ligne, 2) = CboSER.Value
Cells(No_ligne, 4) = CboGRA.Value
Cells(No_ligne, 6) = TxtPRENOM.Value
LiFin(1) = Cells(Rows.Count, 4).End(xlUp).Row
LiFin(2) = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To LiFin(2)
c = c & "µ" & Cells(x, 1)
Next x
c = c & "µ"
For x = 2 To LiFin(1)
a = Cells(x, 4)
If InStr(1, c, a) > 0 Then
Cells(x, 3) = a
Else
Cells(x, 3) = Mid(a, 1, 3)
End If
Next x
Sheets("HA").Select
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 240)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(0, 176, 80)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _
Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[SER]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[[GRA2]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _
Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
Sheets("ST").Select
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(191, 191, 191)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(51, 102, 255)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(0, 128, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add(Range("Table3[Colonne1]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne2]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:="OFF,SG,SCT,CTI,MAT,GAR,SYN,BUD,SEC", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne4]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:= _
"CT,CE1,CE2,CE3,L.1,L.2,L.3,MA,MA1,MA2,MA3 _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne5]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort. _
SortFields.Add Key:=Range("Table3[Colonne6]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ST").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A6").Select
MsgBox ("Modification effectuée")
Unload UserForm4
Load UserForm4
UserForm4.Show
End If
End Sub
'QUITTER le formulaire
Private Sub BtnQuitter_Click()
Unload Me
Sheets("sommaire").Select
End Sub
'RECHERCHER
Private Sub BtnRechercher_Click()
Sheets("HA").Activate
'If CboNom.Value = "" Then
'MsgBox ("Veuillez entrer le nom du fonctionnaire")
If Not CboNOM.Value = "" Then
Dim No_ligne As Integer
No_ligne = CboNOM.ListIndex + 39
CboSEC.Value = Cells(No_ligne, 1).Value
CboSER.Value = Cells(No_ligne, 2).Value
CboGRA.Value = Cells(No_ligne, 4).Value
TxtPRENOM.Value = Cells(No_ligne, 6).Value
Else
End If
'End If
End Sub
'SUPPRIMER UNE LIGNE
Private Sub BtnSUPPRIMER_Click()
If MsgBox("Etes vous sûr de supprimer cette ligne ?", vbYesNo, "Demande de suppression") = vbYes Then
Sheets("HA").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Sheets("ST").Rows([E39:E300].Find(CboNOM.Value).Row).EntireRow.Delete
Unload Me
End If
End Sub
'EVITER LA REPRISE DU NOM
Private Sub CboNom_Change()
CboNOM.MatchEntry = fmMatchEntryNone
'NOM en MAJUSCULE
CboNOM = UCase(CboNOM)
End Sub
'Bloquage bouton AJOUTER
Private Sub TxtPrenom_Change()
If TxtPRENOM <> "" Then
BtnAJOUTER.Enabled = True
Else
BtnAJOUTER.Enabled = False
End If
TxtPRENOM = WorksheetFunction.Proper(TxtPRENOM)
End Sub
Private Sub UserForm_Activate()
TxtPRENOM.Value = ""
CboNOM.Value = ""
End Sub
Super et merci beaucoup
Je commence par le début alors ,comment mettre le code entre balise ?
Ne t'inquiètes pas, ça viendra! Utilises :
Et entre les deux balises, tu colles ton code!
Tu as un bouton au dessus de ton éditeur de texte. A droite de "Mettre en gras" qui s'appelle code. En cliquant dessus, ça te colle les balises codes!
Yann
Essais
Merci beaucoup, j'ai enfin compris la manip
De rien!
Mets moi s'il te plait un exemple de fichier avec lequel faire travailler les macros que tu as donné plus haut s'il te plait. Si tu pouvais me faire un descriptif rapide du rôle de chaques macros, je te serai reconnaissant!
Tu bosses toujours sur mac?
Yann