werafa
03-12-2013, 06:12 PM
Hi,
This code is working: but tweaks and suggestions are appreciated
It allows one to turn an image into a toggle switch
Sub ToggleElectricity()
'assign this macro to an image to turn the image into a toggle switch
Dim myPicture As Shape
Dim myFlag As Range
Call RunFast
Set myPicture = ActiveSheet.Shapes("Picture 10")
Set myFlag = Sheets("Cover").Range("E24")
If UCase(myFlag.Value) = "TRUE" Then 'switch is currently on - set it to off
myFlag.Value = "FALSE"
Call SetToOff(myPicture)
ElseIf UCase(myFlag.Value) = "FALSE" Then 'switch is currently off - set it to on
myFlag.Value = "TRUE"
Call SetToOn(myPicture)
Else 'switch is broken - set it to off
myFlag.Value = "FALSE"
myFlag.Font.ColorIndex = 2
Call SetToOff(myPicture)
End If
Call ResetApp
Set myFlag = Nothing
Set myPicture = Nothing
End Sub
Sub SetToOn(myPicture As Shape)
'Sets 3D fprmatting to banner images on cover page
With myPicture.ThreeD
.SetPresetCamera (msoCameraOrthographicFront)
.RotationY = 0
.FieldOfView = 0
.LightAngle = 145
.PresetLighting = msoLightRigBalanced
.PresetMaterial = msoMaterialWarmMatte
.BevelTopType = msoBevelCircle
.BevelTopInset = 15
.BevelTopDepth = 3
End With
End Sub
Sub SetToOff(myPicture As Shape)
'Sets 3D fprmatting to banner images on cover page
With myPicture.ThreeD
.SetPresetCamera (msoCameraPerspectiveRelaxed)
.RotationY = -50.5
.FieldOfView = 45
.LightAngle = 225
.PresetLighting = msoLightRigBalanced
.PresetMaterial = msoMaterialWarmMatte
.BevelTopType = msoBevelCircle
.BevelTopInset = 15
.BevelTopDepth = 3
End With
End Sub
This code is working: but tweaks and suggestions are appreciated
It allows one to turn an image into a toggle switch
Sub ToggleElectricity()
'assign this macro to an image to turn the image into a toggle switch
Dim myPicture As Shape
Dim myFlag As Range
Call RunFast
Set myPicture = ActiveSheet.Shapes("Picture 10")
Set myFlag = Sheets("Cover").Range("E24")
If UCase(myFlag.Value) = "TRUE" Then 'switch is currently on - set it to off
myFlag.Value = "FALSE"
Call SetToOff(myPicture)
ElseIf UCase(myFlag.Value) = "FALSE" Then 'switch is currently off - set it to on
myFlag.Value = "TRUE"
Call SetToOn(myPicture)
Else 'switch is broken - set it to off
myFlag.Value = "FALSE"
myFlag.Font.ColorIndex = 2
Call SetToOff(myPicture)
End If
Call ResetApp
Set myFlag = Nothing
Set myPicture = Nothing
End Sub
Sub SetToOn(myPicture As Shape)
'Sets 3D fprmatting to banner images on cover page
With myPicture.ThreeD
.SetPresetCamera (msoCameraOrthographicFront)
.RotationY = 0
.FieldOfView = 0
.LightAngle = 145
.PresetLighting = msoLightRigBalanced
.PresetMaterial = msoMaterialWarmMatte
.BevelTopType = msoBevelCircle
.BevelTopInset = 15
.BevelTopDepth = 3
End With
End Sub
Sub SetToOff(myPicture As Shape)
'Sets 3D fprmatting to banner images on cover page
With myPicture.ThreeD
.SetPresetCamera (msoCameraPerspectiveRelaxed)
.RotationY = -50.5
.FieldOfView = 45
.LightAngle = 225
.PresetLighting = msoLightRigBalanced
.PresetMaterial = msoMaterialWarmMatte
.BevelTopType = msoBevelCircle
.BevelTopInset = 15
.BevelTopDepth = 3
End With
End Sub