Public annul 'Evite les rebouclages multiples dans les Worksheet Change
Dim X As Integer
Dim Y As Byte
Private Sub BoutonAjouterNouveauClient_Click()
NouveauClient.Show
End Sub
Private Sub BoutonAjouterSupprimerLigne_Click()
Dim Plage As Range
Set Plage = Range(Range("A" & Range("Surligneur").Row), Range("G" & Range("Surligneur").Row + Range("Surligneur").Rows.Count - 2))
If Not Intersect(Plage, ActiveCell) Is Nothing Then
AjouterSpprimerLigne.Show
Else
MsgBox "Veuillez sélectionner une cellule dans la plage adéquate !", vbInformation, "Attention"
End If
End Sub
Private Sub BoutonOutils_Click()
Range("F1:G1").Select
ChoixOutil.Show
End Sub
Private Sub BoutonTVA_Click()
TauxTVA.Show
End Sub
Private Sub BoutonRéserve_Click()
TauxRéserve.Show
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Mettre la première lettre en majuscule
Dim Plage As Range
Dim M As Range
If Target.Count > 1 Then Exit Sub
Set Plage = Range(Range("C" & Range("NomPropre").Row), Range("C" & Range("NomPropre").Row + Range("NomPropre").Rows.Count - 2))
If Not Intersect(Plage, Target) Is Nothing Then
If Trim(Target.Cells(1, 1)) = "" Then
Rows(Target.Row).RowHeight = 15
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Target = UCase(Left(Target, 1)) & Mid(Target, 2)
'Target = Application.Proper(Target)
Application.EnableEvents = True
'Ajuster la hauteur des lignes
ActiveSheet.Unprotect
Set M = Target.MergeArea
M.UnMerge
M.WrapText = True
M.HorizontalAlignment = xlCenterAcrossSelection
M.Rows.AutoFit
M.Merge
M.HorizontalAlignment = xlGeneral
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingRows:=True
'Mettre en majuscule des cellules
ElseIf Not Application.Intersect(Target, Range("CellulesMajuscule")) Is Nothing Then
If Not IsEmpty(Target) Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Mettre en couleur des cellules - Variable
Dim Plage As Range
'Eviter de saisir des caractère comme % ? / §
If Not Application.Intersect(Target, Range("F14")) Is Nothing Then
ActiveCell = Replace(ActiveCell, "/", "")
ActiveCell = Replace(ActiveCell, ":", "")
ActiveCell = Replace(ActiveCell, "!", "")
ActiveCell = Replace(ActiveCell, "$", "")
ActiveCell = Replace(ActiveCell, "£", "")
ActiveCell = Replace(ActiveCell, ",", "")
ActiveCell = Replace(ActiveCell, ".", "")
ActiveCell = Replace(ActiveCell, "(", "")
ActiveCell = Replace(ActiveCell, ")", "")
ActiveCell = Replace(ActiveCell, "\", "")
ActiveCell = Replace(ActiveCell, "*", "")
ActiveCell = Replace(ActiveCell, "%", "")
ActiveCell = Replace(ActiveCell, ";", "")
ActiveCell = Replace(ActiveCell, "§", "")
ActiveCell = Replace(ActiveCell, "^", "")
ActiveCell = Replace(ActiveCell, "¨", "")
ActiveCell = Replace(ActiveCell, "?", "")
ActiveCell = Replace(ActiveCell, "*", "")
ActiveCell = Replace(ActiveCell, "µ", "")
ActiveCell = Replace(ActiveCell, "=", "")
End If
'Mettre en couleur des cellules - Suite
Set Plage = Range(Range("A" & Range("Surligneur").Row), Range("G" & Range("Surligneur").Row + Range("Surligneur").Rows.Count - 2))
Plage.Interior.ColorIndex = xlNone
If Not Intersect(Plage, Target) Is Nothing Then
Range("A" & Target.Row).Resize(1, 7).Interior.ColorIndex = 44
End If
End Sub