Option Explicit
-----------------------------------------------------------------------------------
Private Sub Workbook_Activate()
Application.OnKey "%{F8}", ""
ControleImage
End Sub
-----------------------------------------------------------------------------------
Private Sub Workbook_Deactivate()
Me.Worksheets(1).[IV1].Copy 'vide le presse-papier
Application.CutCopyMode = False
Application.OnTime t, "ControleImage", , False
End Sub
------------------------------------------------------------------------------------
Private Sub Workbook_Open()
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
Application.CommandBars("Worksheet Menu Bar").Enabled = False
Next CmdB
Call InterdireCopierCouper
Dim lgDerLig As Long
'Sur timer de 15 secondes, on ferme l'appli
NewTimer = Time() + TimeValue("00:13:20")
Application.OnTime NewTimer, "CloseSurTimer"
USFuser.Show
' Si aucun nom n'a été saisi, on quite l'appli
If NomUtil = "" Then ThisWorkbook.Close
' Sauvegarder le nom de l'utilisateur et la date de connexion
With Worksheets("Connexion")
.Visible = True
lgDerLig = .Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
.Range("A" & lgDerLig).Value = NomUtil
.Range("B" & lgDerLig).Value = Format(Date, "dddd d mmm yyyy")
.Range("C" & lgDerLig).Value = Time()
.Visible = False
End With
' sinon on continue
'Récupère la propriété du classeur si lecture seule
WbkRO = ThisWorkbook.ReadOnly
'Load UserForm1 'cela doit être enlevé car UserForm1.Show effectue le load
UserForm1.Show
bProtect = False
End Sub
------------------------------------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'enregistre en quittant
Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = True
Next CmdB
Call RetablirCopierCouper
Dim intWS As Integer
'Si le classeur n'est pas en lecture seule
If WbkRO = False Then
' Si la déprotection/protection est autorisée
If varProtect = True And bProtect = True Then
' Boucle sur toutes les feuilles du classeur
For intWS = 1 To ThisWorkbook.Worksheets.Count
If Sheets(intWS).Name <> "historiq" And Sheets(intWS).Name <> "Users" _
And Sheets(intWS).Name <> "Connexion" Then
' Protection de la feuille
Sheets(intWS).Protect Password:=MdP, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Next intWS
End If
ActiveWindow.DisplayWorkbookTabs = False
ThisWorkbook.Save
End If
Application.DisplayAlerts = True
End Sub
---------------------------------------------------------------------------------------------------------------
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim icbc As Object
' Sort de la procédure si le nombre de cellule >1
If Target.Count > 1 Then Exit Sub
' Si l'utilisateur n'est pas sur la bonne feuille
If InStr(1, "stock historiq Connexion références Users", Sh.Name, vbTextCompare) > 0 Then
For Each icbc In Application.CommandBars("cell").Controls
If icbc.Tag = "brccm" Then icbc.Delete
Next icbc
Exit Sub
End If
' Sinon on continue
xnomfeuil = Sh.Name
reference = Target.Value
' Vérifier sur quelle colonne l'utilisateur se trouve
If Target.Column <= 4 Or Target.Column = 9 Then
For Each icbc In Application.CommandBars("cell").Controls
If icbc.Tag = "brccm" Then icbc.Delete
Next icbc
With Application.CommandBars("cell").Controls _
.Add(before:=5, temporary:=True)
.Caption = "Visualisation quantité"
.OnAction = "affiche4"
.Tag = "brccm"
End With
Else
For Each icbc In Application.CommandBars("cell").Controls
If icbc.Tag = "brccm" Then icbc.Delete
Next icbc
End If
End Sub
----------------------------------------------------------------------------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
' Un changement à été effectué, on annule le précdent timer
Application.OnTime NewTimer, "CloseSurTimer", Schedule:=False
' Sur timer de 15 secondes, on ferme l'appli
NewTimer = Time() + TimeValue("00:13:20")
Application.OnTime NewTimer, "CloseSurTimer"
On Error GoTo 0
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim sFeuille As String
Cancel = True
sFeuille = ActiveSheet.Name
If ActiveSheet.Name <> Sh5.Name Then
MsgBox "Vous n'avez pas le droit d'imprimer ce document"
Exit Sub
Else
Application.EnableEvents = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.EnableEvents = True
End If
End Sub
MODULE 1
Global NomUtil As String
Global varProtect As Boolean
' <<< Modif le 23/12
Global bProtect As Boolean
' >>> Modif le 23/12
Global WbkRO As Boolean ' Définir dans cette variable si le classeur est en lecture seule
Global NewTimer
-----------------------------------------------------------------------------------------------------------
Sub Affiche()
'Load UserForm1 ' il est inutile d'effectuer un load avant un show de la feuille
UserForm1.Show
End Sub
-----------------------------------------------------------------------------------------------------------
Public Sub DeprotegeProtege()
' <<< Modif le 23/12
If varProtect = True Then UserForm5.Show vbModal
' >>> Modif le 23/12
End Sub
-----------------------------------------------------------------------------------------------------------
Public Sub CloseSurTimer()
Application.DisplayAlerts = False
If WbkRO = True Then
ThisWorkbook.Close SaveChanges:=False
Else
ThisWorkbook.Close SaveChanges:=True
End If
End Sub
MODULE 7
Public t As Date
Sub ControleImage()
Dim a As String
ThisWorkbook.Worksheets(1).[IV1].Copy 'vide le presse-papier
Application.CutCopyMode = False
On Error Resume Next
a = Selection.Address
If Err Then Selection.Delete
t = Now + 1 / 86400
Application.OnTime t, "ControleImage"
End Sub
