Option Explicit
'Application.DisplayAlerts = True 'Message d'alerte affiché
Sub Message()
MsgBox "BONJOUR"
End Sub
Sub Cadre()
'Aucune Bordure
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Recoloriage
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With Selection.Borders(xlInsideVertical)
If Selection.Borders(xlInsideVertical).LineStyle < 1 Then
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 3
End If
End With
With Selection.Borders(xlInsideHorizontal)
If Selection.Borders(xlInsideHorizontal).LineStyle < 1 Then
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 3
End If
End With
End Sub
Sub Centrage_Vertical()
With Selection
.VerticalAlignment = xlCenter
End With
End Sub
Sub Commentaire()
With Selection
.AddComment
.Comment.Text Text:="COMMENTAIRE"
.Comment.Visible = True
End With
End Sub
Sub Filtre_Auto()
On Error GoTo Erreur_FiltreAuto
Selection.AutoFilter
Erreur_FiltreAuto:
Exit Sub
End Sub
Sub Fusion()
If Selection.MergeCells = True Then 'Fusionné
'On défusionne
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Else
'On fusionne
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
End If
End Sub
Sub HautGauche()
'Positionne la cellule active en Haut et à Gauche de l'écran
ActiveWindow.ScrollRow = ActiveCell.Row
ActiveWindow.ScrollColumn = ActiveCell.Column
End Sub
Sub AfficheMasque_Grille()
If ActiveWindow.DisplayGridlines = False Then
ActiveWindow.DisplayGridlines = True
Else
ActiveWindow.DisplayGridlines = False
End If
End Sub
Sub Protection()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub RenvoiLigneAuto()
If Selection.WrapText = False Then
Selection.WrapText = True
Else
Selection.WrapText = False
End If
End Sub
Sub AfficheMasqueZéro()
If ActiveWindow.DisplayZeros = True Then
ActiveWindow.DisplayZeros = False
Else
ActiveWindow.DisplayZeros = True
End If
End Sub
Sub MêmeHauteur_MêmeLargeur()
'Faire une selection de plusieurs cellules et lancer la macro
For Each xCell In Selection
xCell.RowHeight = xCell.Width
Next
End Sub
Sub Euro()
Selection.NumberFormat = "#,##0.00 $"
End Sub
Sub CalculAutomatique()
Application.Calculation = xlAutomatic
End Sub
Sub AfficheHauteurLigne()
MsgBox "Faire une selection de plusieures ligne"
Dim xCell
With ActiveSheet
For Each xCell In Selection
xCell.Value = xCell.RowHeight
Next xCell
End With
End Sub
