Macro unprotect and protect sheet

[noelmus]

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]

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]

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]

But do you have a formula?
What does the formula say?

 

[noelmus]

=if('B'!c2="",'B'!b2+'B'!n39-'B'!d2,'B'!c2)

 

[DanteAmor]

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]

This is the code in sheet "A".

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]

Adjust this macro

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]

Hi Dante,
Thanks a lot, it works excellent.
I really appreciate your professional help.

Regards

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.