Code VBA qui fonctionnent après plus de cinq minutes

Le 27/09/2017 à 23:11

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

Le 28/09/2017 à 06:45

Bonjour,

Il faut absolument utiliser les balises Code ...

Le 28/09/2017 à 08:38

Bonjour,

Mon dieu.. Ce code est illisible! Elles servent à quoi ces macros? Tu as un fichier pour les contextualiser?

Yann

Le 28/09/2017 à 09:21

[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 28/09/2017 à 09:26

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
Le 28/09/2017 à 09:39

Super et merci beaucoup

Je commence par le début alors ,comment mettre le code entre balise ?

Le 28/09/2017 à 09:43

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

Le 28/09/2017 à 09:47
Essais

Merci beaucoup, j'ai enfin compris la manip

Le 28/09/2017 à 09:51

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

Rechercher des sujets similaires à "code vba qui fonctionnent cinq minutes"