View Single Post
  #17   Report Post  
Posted to microsoft.public.excel.misc
Ken Johnson Ken Johnson is offline
external usenet poster
 
Posts: 1,073
Default How do I reference graphic images in formulas rather than text

Hi Daigles,

I've encountered a new error that occurs when you have other workbooks
open at the same time.

My solution to this new problem is to add one extra line of code so
that the Sub is exited when ever calculation is triggered by another
open workbook...

Private Sub Worksheet_Calculate()
If Me.Parent.Name < ActiveSheet.Parent.Name Then Exit Sub
Application.ScreenUpdating = False
'next 3 lines of code are the first part of
'the solution to the "average of values
'on other sheet" problem
Dim strActiveSheet As String
strActiveSheet = ActiveSheet.Name
Me.Activate
'Edit the value of strHorizontal depending
'on where you want the Pie image to be
'horizontally positioned in the cell.
'Values used by the code are...
'"Left", "Center" or "Right" (not case sensitive)
Const strHorizontal As String = "center"
'Edit the value of strVertical depending
'on where you want the Pie image to be
'Vertically positioned in the cell.
'Values used by the code are...
'"Top", "Center" or "Bottom" (not case sensitive)
Const strVertical As String = "center"
Dim iHorizontal As Single
Dim iVertical As Single
Select Case UCase(strHorizontal)
Case "LEFT"
iHorizontal = 0
Case "CENTER"
iHorizontal = 0.5
Case "RIGHT"
iHorizontal = 1
End Select
Select Case UCase(strVertical)
Case "TOP"
iVertical = 0
Case "CENTER"
iVertical = 0.5
Case "BOTTOM"
iVertical = 1
End Select
Dim strActiveCellAddress As String
strActiveCellAddress = ActiveCell.Address
Dim rngCell As Range
Dim strPie As String
Dim ShpPie As Shape
For Each rngCell In Range("B2:D11")
On Error Resume Next
Me.Shapes("~" & rngCell.Address).Delete
strPie = ""
On Error GoTo 0
Select Case rngCell.Value
Case ""
Case Is < 0
Case Is < 0.125
strPie = "None"
Case Is < 0.375
strPie = "Quarter"
Case Is < 0.625
strPie = "Half"
Case Is < 0.875
strPie = "ThreeQuarters"
Case Is <= 1
strPie = "Full"
End Select
If strPie < "" Then
Me.Shapes(strPie).Copy
Range(rngCell.Address).PasteSpecial
Selection.Name = "~" & rngCell.Address
Set ShpPie = Me.Shapes("~" & rngCell.Address)
ShpPie.Left = rngCell.Left + _
iHorizontal * (rngCell.Width - ShpPie.Width)
ShpPie.Top = rngCell.Top + _
iVertical * (rngCell.Height - ShpPie.Height)
End If
Next rngCell
Range(strActiveCellAddress).Select
'next line of code is the last part of the solution
'to the "average of values on other sheet" problem
Sheets(strActiveSheet).Activate
End Sub

Ken Johnson