Bonjour,
sur le document :
Private Sub Workbook_Open()
With Application
If .ShowDevTools = True Then
.ShowDevTools = False
.OnKey "%{F11}", ""
End If
End With
'affichage agrandir à l'ouverture'
Application.WindowState = xlMaximized
'pleins écran ouverture'
'Application.DisplayFullScreen = True'
End Sub
7 feuilles bientôt 8
et seulement sur la première j'ai ça comme macro événementielle :
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
MsgBox ("merci utiliser fonction prédéfini")
Cells(500, 100).Select
Selection.Activate
'désactiver mode développer'
With Application
If .ShowDevTools = True Then
.ShowDevTools = False
.OnKey "%{F11}", ""
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'si valeure de la cellule change alors ajout de bordure'
If Not Intersect(Target, Range("B:O")) Is Nothing Then
'ajout de bordure'
With Target.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Target.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Target.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Target.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
'désactiver mode développer'
With Application
If .ShowDevTools = True Then
.ShowDevTools = False
.OnKey "%{F11}", ""
End If
End With
'SAUVEGARDE AUTOMATIQUE'
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("A1:AD6,A:A"), Target) Is Nothing Then
Cells(7, 2).Select
End If
'désactiver mode développer'
With Application
If .ShowDevTools = True Then
.ShowDevTools = False
.OnKey "%{F11}", ""
End If
End With
End Sub
'empecher double clic gauche souris'
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' MsgBox ("Merci de ne pas faire de doucle-clic sur cette page")
' Cells(7, 2).Select
'End Sub