Hi
I have this code (Below) and I want to cut and paste Shape "C" to Sheet 2.
What I need to change in the code so that Shape "C" will work in Sheet 2?
Option Explicit
Private Sub AdjustTank(ByVal CurLevel As Double, ByVal TankID As String, _
Optional 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 < 80000 Then
Level.Fill.ForeColor.RGB = RGB(255, 228, 225)
ElseIf CurLevel >= 80000 And CurLevel < 400000 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 LastValueJ, LastValueH, LastValueG
Dim shp As Shape, height As Double
With Range("j24")
If LastValueJ <> .Value Then
AdjustTank .Value, "A"
LastValueJ = .Value
End If
End With
With Range("H24")
If LastValueH <> .Value Then
AdjustTank .Value, "B"
LastValueH = .Value
End If
End With
With Range("G27")
If LastValueG <> .Value Then
AdjustTank .Value, "C"
LastValueG = .Value
End If
End With
End Sub
Sub test()
Me.Shapes("BackGroundA").Left = Me.Shapes("FrameA").Left
Me.Shapes("BackGroundA").Top = Me.Shapes("FrameA").Top
End Sub
Thanks in advance
I have this code (Below) and I want to cut and paste Shape "C" to Sheet 2.
What I need to change in the code so that Shape "C" will work in Sheet 2?
Option Explicit
Private Sub AdjustTank(ByVal CurLevel As Double, ByVal TankID As String, _
Optional 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 < 80000 Then
Level.Fill.ForeColor.RGB = RGB(255, 228, 225)
ElseIf CurLevel >= 80000 And CurLevel < 400000 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 LastValueJ, LastValueH, LastValueG
Dim shp As Shape, height As Double
With Range("j24")
If LastValueJ <> .Value Then
AdjustTank .Value, "A"
LastValueJ = .Value
End If
End With
With Range("H24")
If LastValueH <> .Value Then
AdjustTank .Value, "B"
LastValueH = .Value
End If
End With
With Range("G27")
If LastValueG <> .Value Then
AdjustTank .Value, "C"
LastValueG = .Value
End If
End With
End Sub
Sub test()
Me.Shapes("BackGroundA").Left = Me.Shapes("FrameA").Left
Me.Shapes("BackGroundA").Top = Me.Shapes("FrameA").Top
End Sub
Thanks in advance