PDA

View Full Version : Turn an image into a toggle button



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

SamT
03-12-2013, 06:56 PM
How About ...
Sub ToggleElectricity()
'assign this macro to an image to turn the image into a toggle switch
Dim myPicture As Shape
Dim myFlagRng As Range
Dim MyFlag As Boolean
Call RunFast
Set myPicture = ActiveSheet.Shapes("Picture 10")
Set MyFlag = Sheets("Cover").Range("E24")
MyFlag = myFlagRng.Value
MyFlag = Not MyFlag
myFlagRng.Value = MyFlag
ToggleMyPicture myPicture, MyFlag
Call ResetApp
Set myFlagRng = Nothing
Set myPicture = Nothing
End Sub

Sub ToggleMyPicture(myPicture As Shape, MyFlag As Boolean)
'Sets 3D fprmatting to banner images on cover page
With myPicture
If MyFlag Then
.SetPresetCamera (msoCameraOrthographicFront)
.RotationY = 0
.FieldOfView = 0
.LightAngle = 145
Else
.SetPresetCamera (msoCameraPerspectiveRelaxed)
.RotationY = -50.5
.FieldOfView = 45
.LightAngle = 225
End If
End With
End Sub

SamT
03-12-2013, 07:02 PM
If you don't want to store MyFlagRng in a Range
If MyPicture.RotationY = 0 Then MyFlag = True 'Or False, it don't matter

werafa
03-12-2013, 07:10 PM
not bad.

I was also trying to achieve a 'grayed out' look, but got beat (!@#$ macro recorder...)
The flagrange was to pass the variable to other code - but I ended up setting a public variable (which I usually like to avoid) as this setting is rather fundamental to everything subsequent

anyway, I thought that this was useful enough to make it available back to the vbax community in return for all the help I have received - so please keep adding thoughts and improvements - especially to the visual effects

thanks