un internaute
XLDnaute Impliqué
Bonjour le forum
Lorsque je fait un choix => Exemple => Contrôle technique qui est le 23ème et dernier onglet et que je fait quelque chose puis j'enregistre
A l'ouverture ça sera toujours sur Contrôle technique et non sur TOTO (1er onglet)
Merci à vous pour vos éventuels retours
Macros ci-dessous
ThisWorkbook
Code Userform
Lorsque je fait un choix => Exemple => Contrôle technique qui est le 23ème et dernier onglet et que je fait quelque chose puis j'enregistre
A l'ouverture ça sera toujours sur Contrôle technique et non sur TOTO (1er onglet)
Merci à vous pour vos éventuels retours
Macros ci-dessous
ThisWorkbook
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A3:A" & Rows.Count)) Is Nothing Then
Application.EnableEvents = False
If Not IsDate(Target) Then
Target.Resize(, 4).ClearContents
Else
Range("B" & Target.Row) = Sh.Name
Range("C" & Target.Row) = "Oui"
End If
Range("D" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))
Target = IIf(Target = "", "", Application.Proper(Format(CDate(Cells(Target.Row, 4)), "dddd dd mmmm yyyy"))) ' En cas de suppression manuelle de la colonne A
End If
Range("A1").Select
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Indice As Integer, NbColonne As Integer
Dim Tb, TbCoul, X, TbFont, Label As String
Dim Cel As Range
Dim Ligne As Integer
Application.Calculation = xlCalculationAutomatic
Select Case UCase(Sh.Name) ' Cette ligne permet de modifier l'onglet. Exemple "Matelas Tournés" sans modifier la macro "MATELAS TOURNÉS"
Case "TOTO"
NbColonne = 3
If Target.Column = NbColonne + 1 And Target.Row >= 3 And Range("A" & Target.Row) <> "" Then
Application.EnableEvents = False
TbFont = Array(5, 1) 'Ces 3 Lignes en commentaire pour afficher Non
TbCoul = Array(35, 40)
Tb = Array("", "Oui")
Cancel = True
X = UCase(Trim(Target))
If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Label = Tb(Indice)
With Target
.Value = Label
.Interior.ColorIndex = TbCoul(Indice)
.Font.ColorIndex = TbFont(Indice)
End With
With ActiveCell.Offset(0, -NbColonne).Resize(1, NbColonne)
If Label = "Oui" Then
Target.Offset(, 1) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
Target.Offset(, -3).Resize(, 3).Font.Strikethrough = True
Else 'Else seul pour effacer la date au Double Click
' ElseIf Label = "Non" Then 'ElseIf Label = "Non" Then => pour ne pas effacer la date au Double Click
Target.Offset(, -3).Resize(, 3).Font.Strikethrough = False
Target.Offset(, 1).ClearContents
End If
End With
End If
End If
Application.EnableEvents = True
Case Else
If Not Intersect(Target, Range("C4:C" & Range("A" & Rows.Count).End(xlUp).Row + 1)) Is Nothing Then
Application.ScreenUpdating = False
Ligne = Range("A" & Rows.Count).End(xlUp).Row
If (Target.Row = Ligne And Range("A" & Ligne) <> "") Or (Target.Row = Ligne + 1 And Range("A" & Ligne + 1) = "") Then
Application.EnableEvents = False
TbFont = Array(5, 1) 'Ces 3 Lignes en commentaire pour ne pas afficher Non
TbCoul = Array(35, 40)
Tb = Array("", "Oui")
Cancel = True
X = UCase(Trim(Target))
If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
Label = Tb(Indice)
Set Cel = Target
If Label = "Oui" Then
If Target.Row = 21 Then ' On clicque sur la ligne 21 pour un nouvea cycle
Range("A3:D20").ClearContents
Range("C3:C20").Interior.ColorIndex = 35
Set Cel = Range("C3")
End If
Cel.Offset(, -2).Resize(, 2).Font.Strikethrough = True
Cel.Offset(, 1).Value = Date
Cel.Offset(, -2) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
Cel.Offset(, -1).Value = Sh.Name
Else
Cel.Offset(0, -2).Resize(1, 2).Font.Strikethrough = False
Cel.Offset(, -2).Resize(, 4).ClearContents
Cel.Offset(, 1).Interior.ColorIndex = 36
Cel.Offset(, 2).Interior.ColorIndex = 8
Cel.Offset(, -2).Interior.ColorIndex = 36
Cel.Offset(, -1).Interior.ColorIndex = 35
End If
End If
With Cel
.Value = Label
.Interior.ColorIndex = TbCoul(Indice)
.Font.ColorIndex = TbFont(Indice)
End With
Application.EnableEvents = True
End If
End If
End Select
If Target.Address = "$F$1" Then
Cancel = True
UsfChoix.Show 0
End If
Range("A1").Select
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
For I = 1 To Sheets.Count
If Sheets(I).Name <> "TOTO" Then Sheets(I).Visible = False
Next I
End SubCode Userform
Code:
Option Explicit
Private Sub ComboBox1_Change()
Dim I As Integer
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
Application.ScreenUpdating = False
With Sheets(Me.ComboBox1.Value)
.Visible = xlSheetVisible
' .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
For I = 1 To Sheets.Count
If Sheets(I).Name <> Me.ComboBox1 Then Sheets(I).Visible = xlSheetVeryHidden
Next I
Unload Me
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim I As Integer
With Me.ComboBox1
.Font.Size = 12
For I = 1 To Sheets.Count
.AddItem Sheets(I).Name
Next I
End With
End Sub
