1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Sub cadenasOF()
Dim rg As Range, ws As Worksheet
'image mosaique
' 200, 200, 70, 70 posit à gauche, en ht, etir à droite, etir en bas
'Shapes.AddPicture "E:\Users\FRANCK\Documents\FRANCK\EXCEL\JOB\réparations\photos\" & "mosaique repar GP.jpg", True, True, 200, 30, 900, 370
'Le cadenas est ouvert
'si zone non protégée on la protège
If wsAcceuil.ProtectContents = False Then
Application.Visible = False
Set rg = wsAcceuil.Range("A1:S8")
ActiveWindow.Zoom = 100
wsAcceuil.Shapes("Img_protect").Visible = msoTrue 'cadenas ferme visible
wsAcceuil.Shapes("Img_unprotect").Visible = msoFalse
With ActiveWindow
.DisplayHorizontalScrollBar = False 'ascens H invisible
.DisplayVerticalScrollBar = False 'ascens V invisible
.DisplayWorkbookTabs = False 'onglets invisibles
.DisplayHeadings = False 'entetes invisibles
End With
' rg.Select
wsAcceuil.ScrollArea = rg.Address
ActiveWindow.Zoom = True 'zoom sur la sélection
wsAcceuil.Cells(1, 1).Select
wsAcceuil.Select
wsAcceuil.Protect wsAcceuil.Range("password") 'on prend le mdp dans la cell. du champ nommé.
Else
'Le cadenas est fermé
'zone protégée on la déprotège
On Error Resume Next
wsAcceuil.Unprotect
If wsAcceuil.ProtectContents = False Then 'si zone protégée
Application.Visible = True
Set rg = wsAcceuil.Range("A1:S8")
ActiveWindow.Zoom = 100
wsAcceuil.Shapes("Img_protect").Visible = msoFalse
wsAcceuil.Shapes("Img_unprotect").Visible = msoTrue 'cadenas ouvert visible
With ActiveWindow
.DisplayHorizontalScrollBar = True 'ascens H visible
.DisplayVerticalScrollBar = True 'ascens V visible
.DisplayWorkbookTabs = True 'onglets visibles
.DisplayHeadings = True 'entetes visibles
End With
' rg.Select
wsAcceuil.ScrollArea = "" 'on vide la zone
Else
Exit Sub
End If
End If
Set rg = Nothing 'on vide la zone
'Application.FormulaBarHeight = 1 'barre de formule limitée à une ligne
'X1cShortcutOnDesk "Icon", "Mono-poste", "mono-ico" 'raccourci sur le bureau
Application.ExecuteExcel4Macro "SHOW.TOOLBAR[""Ribbon"",False)" 'cache le menu d'excel 'ruban menu excel
'Application.WindowState = xlMaximized 'max de l'appli avec l'écran
End Sub |
Partager