Macro unprotect and protect sheet

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
93
I have sheet "A" with shapes which updates when changes is made in sheet "B". I need to protect sheet "A" since no one touch the shapes. The problem is that since sheet "A" is protected, updates fail. I need a macro that unprotect the sheet, then update and then protect the sheet again.
Is this possible?

Thanks in advance
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
And how do you update the sheet "A", with a macro? that is, I have sheet "A" with shapes which updates when changes is made in sheet "B". How do you do that?
 

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
93
By giving new values in sheet "B", cell W36 in sheet "A" updates and then shapes in sheet "A" updates through cell W36.

Thanks
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
But do you have a formula?
What does the formula say?
 

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
93
=if('B'!c2="",'B'!b2+'B'!n39-'B'!d2,'B'!c2)
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
But if you modify the values ​​of sheet2, it is not the error if sheet1 is protected. You must have something more. How are the shapes updated on your sheet A, do you have a macro?



These are the instructions to unprotect the sheet and protect the sheet. Change "abc" by your password

sheets("A").unprotect "abc"


sheets("A").Protect "abc"
 

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
93
This is the code in sheet "A".
Code:
Option ExplicitPrivate Sub AdjustTank(ByVal CurLevel As Double, ByVal TankID As String, _
    Optional ByVal MaxLevel As Double = 400000)
    Dim Tank As Shape, Frame As Shape, Level As Shape, Number As Shape
    'Refer to he Tank shape
    Set Tank = Me.Shapes("Tank" & TankID)
    'Refer to the shapes inside
    Set Frame = Tank.GroupItems("FrameA")
    Set Level = Tank.GroupItems("LevelA")
    Set Number = Tank.GroupItems("NumberA")


    'Be sure the new level is not above the max level
    If CurLevel > MaxLevel Then CurLevel = MaxLevel
    'Write the new level number into the TextBox
    Number.TextFrame2.TextRange.Text = Format(CurLevel, "#,##0")


    'Calculate the height of the level according to the max. level
    Level.Height = (Frame.Height - 2) / MaxLevel * CurLevel
    'Move the level to the bottom
    Level.Top = Frame.Top + Frame.Height - Level.Height - 1
  
    'Move the number into the middle
    Number.Left = Frame.Left + Frame.Width / 2 - Number.Width / 2
    'And below the level line
    Number.Top = Level.Top - 3
    'If the number is too low move it to the lowest possible position
    If Number.Top + Number.Height > Frame.Top + Frame.Height Then
        Number.Top = Level.Top - Number.Height + 3
    End If
    If CurLevel < 0.25 * MaxLevel Then
        Level.Fill.ForeColor.RGB = RGB(255, 228, 225)
    ElseIf CurLevel < 0.9 * MaxLevel Then
        Level.Fill.ForeColor.RGB = RGB(135, 206, 250)
    Else
        Level.Fill.ForeColor.RGB = RGB(152, 251, 152)
    End If
    
End Sub


Private Sub Worksheet_Calculate()
    Static LastValue(0 To 8)
    Dim TankNames
    Dim TankCapacities
    Dim CellAddresses
    Dim i As Long
    TankNames = Array("1", "2", "3", "4", "D/F JET", "9", "10", "D/F AVGAS", "Skytanking")
    TankCapacities = Array(277000, 400000, 216000, 216000, 15000, 23000, 23000, 1000, 10000000)
    CellAddresses = Array("W36", "W25", "W44", "W52", "T5", "T6", "T7", "T8", "U11")
    For i = 0 To 8
        With Range(CellAddresses(i))
            If LastValue(i) <> .Value Then
                AdjustTank .Value, TankNames(i), TankCapacities(i)
                LastValue(i) = .Value
            End If
        End With
    Next i
End Sub




Sub test()
  Me.Shapes("BackGroundA").Left = Me.Shapes("FrameA").Left
  Me.Shapes("BackGroundA").Top = Me.Shapes("FrameA").Top
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
Adjust this macro


Code:
Private Sub Worksheet_Calculate()
    Static LastValue(0 To 8)
    Dim TankNames
    Dim TankCapacities
    Dim CellAddresses
    Dim i As Long
    TankNames = Array("1", "2", "3", "4", "D/F JET", "9", "10", "D/F AVGAS", "Skytanking")
    TankCapacities = Array(277000, 400000, 216000, 216000, 15000, 23000, 23000, 1000, 10000000)
    CellAddresses = Array("W36", "W25", "W44", "W52", "T5", "T6", "T7", "T8", "U11")

    [COLOR=#0000ff]sheets("A").Unprotect "abc"[/COLOR]


    For i = 0 To 8
        With Range(CellAddresses(i))
            If LastValue(i) <> .Value Then
                AdjustTank .Value, TankNames(i), TankCapacities(i)
                LastValue(i) = .Value
            End If
        End With
    Next i

    [COLOR=#0000ff]sheets("A").Protect "abc"
[/COLOR]

End Sub
 

noelmus

Board Regular
Joined
Dec 30, 2018
Messages
93
Hi Dante,
Thanks a lot, it works excellent.
I really appreciate your professional help.

Regards
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,735
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,081,578
Messages
5,359,740
Members
400,545
Latest member
Damntheman30

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top