NOW SOLVED : JWalk's toolbar calculator problem

[Chris Davison]

Just testing the ability to edit the subject line if I'm happy my question has been solved.....

if anyone else wants to put a solved flag, you need to do it in your intial posting, it won't work in any other posts.
===========================================


Does anyone else use JWalk's calculator toolbar ?

mine crashes whenever I click on the decimal point

"Run-time error '13' :

Type mismatch"

does anyone else have this problem ?

(I emailed him and he said he'd look into it but didn't get back to me....(I know he's very very busy)

I have this problem on two machines so know it's not my machine or the way I installed it or something......

Any ideas ?

Here's the whole code

' Copyright 2001, JWalk & Associates, Inc.
' This add-in may be freely distributed for personal use.
' It may not be distributed as part of any commercial product.
' http://j-walk.com/ss

Option Explicit
Option Private Module
Public Const APPNAME As String = "Toolbar Calculator"
' Used for undoing cell paste
Public UndoCell As Range
Public UndoValue As Variant
Public UndoFormat As String
' Global variables
Public LastInput As String
Public DecimalFlag As Boolean
Public OpFlag As String
Public NumOps As Integer
Dim Op1 As Variant
Dim Op2 As Variant
Public Readout As String

Sub ShowCalculatorToolbar()
' Executed by the Tools menu command
' and called when this workbook is opened

' If toolbar exists toggle display
Dim ComBarCalculator As CommandBar
On Error Resume Next
Set ComBarCalculator = Application.CommandBars(APPNAME)
If Err.Number = 0 Then
ComBarCalculator.Visible = Not ComBarCalculator.Visible
On Error GoTo 0
Exit Sub
Else
Call CreateToolbar
End If
On Error GoTo 0
End Sub

Sub CreateToolbar()
' Creates the toolbar
Dim ComBarCalculator As CommandBar
Dim Ctl As CommandBarControl
Dim SubCtl As CommandBarControl

' Delete it if it already exists
On Error Resume Next
Application.CommandBars(APPNAME).Delete
On Error GoTo 0

' Create the toolbar
Set ComBarCalculator = Application.CommandBars.Add(APPNAME)

' Add the Readout (edit box)
Set Ctl = Application.CommandBars(APPNAME).Controls.Add(Type:=msoControlEdit)
Ctl.width = 173

' Add the other buttons (see the AddButton procedure, below)
AddButton 30, "7"
AddButton 30, "8"
AddButton 30, "9"
AddButton 23, "" 'spacer
AddButton 30, "C", "Clear All"
AddButton 30, "CE", "Clear Entry"

AddButton 30, "4"
AddButton 30, "5"
AddButton 30, "6"
AddButton 23, "" 'spacer
AddButton 30, "+", "Plus"
AddButton 30, "-", "Minus"

AddButton 30, "1"
AddButton 30, "2"
AddButton 30, "3"
AddButton 23, "" 'spacer
AddButton 30, "X", "Multiplied by"
AddButton 30, "/", "Divided by"

AddButton 60, "0"
AddButton 30, Application.International(xlDecimalSeparator), "Decimal"
AddButton 23, "" 'spacer
AddButton 60, "=", "Equals"

' Add Help button, and sub buttons
Set Ctl = Application.CommandBars(APPNAME).Controls.Add(msoControlPopup)
With Ctl
.caption = "Help"
.width = 60
Set SubCtl = .Controls.Add 'Help
With SubCtl
.caption = "Help..."
.OnAction = "HelpClick"
.FaceId = 984
End With
Set SubCtl = .Controls.Add 'About
With SubCtl
.caption = "About..."
.OnAction = "AboutClick"
End With
End With

' Add Paste Button
Set Ctl = Application.CommandBars(APPNAME).Controls.Add
With Ctl
.Style = msoButtonCaption
.width = 112
.caption = "Paste to cell"
.TooltipText = "Paste the result to the active cell"
.OnAction = "PasteToCellClick"
End With

' Adjust the toolbar
With ComBarCalculator
.Visible = True
.width = 179 'This forces the row breaks
.Protection = msoBarNoChangeDock + msoBarNoResize + msoBarNoCustomize
End With

Call ResetCalculator
End Sub

Sub AddButton(width, caption, Optional tooltip)
' Adds a button to the CommandBar
Dim Btn As CommandBarButton
Set Btn = Application.CommandBars(APPNAME).Controls.Add
With Btn
.Style = msoButtonCaption
.width = width
.caption = caption
.State = msoButtonDown
.OnAction = "Butt*******"
If Not IsMissing(tooltip) Then .TooltipText = tooltip
If caption = "" Then .Enabled = False
End With
End Sub

Sub Butt*******()
' Event procedure for all button clicks
' Depending on the button, it calls other procedures
Dim BtnIndex
Dim Btn As Variant
BtnIndex = Application.Caller(1)
Btn = Application.CommandBars(APPNAME).Controls(BtnIndex).caption
Select Case Btn
Case 0 To 9: Call NumberClick(Btn)
Case "+", "-", "X", "/", "=": Call OperatorClick(Btn)
Case Application.International(xlDecimalSeparator): Call DecimalClick
Case "C": Call ClearClick
Case "CE": Call ClearEntryClick
Case "Paste to cell": Call PasteToCellClick
End Select
End Sub

Sub DecimalClick()
' Click event procedure for decimal point (.) key.
If Left(Readout, 1) = "*" Then Call ResetCalculator
If LastInput = "NEG" Then
Readout = "-0" & Application.International(xlDecimalSeparator)
ElseIf LastInput <> "NUMS" Then
Readout = "0" & Application.International(xlDecimalSeparator)
End If
DecimalFlag = True
LastInput = "NUMS"
Application.CommandBars(APPNAME).Controls(1).Text = Readout
End Sub

Sub NumberClick(Index)
' Click event procedure for number keys (0-9).
If Left(Readout, 1) = "*" Then Call ResetCalculator
If Application.CommandBars(APPNAME).Controls(1).width > 173 Then
MsgBox "Number is too long!", vbCritical, APPNAME
Call ResetCalculator
Exit Sub
End If
If LastInput <> "NUMS" Then
Readout = Application.International(xlDecimalSeparator)
DecimalFlag = False
End If
If DecimalFlag Then
Readout = Readout & Index
Else
Readout = Left(Readout, InStr(Readout, Application.International(xlDecimalSeparator)) - 1) & Index & Application.International(xlDecimalSeparator)
End If
If LastInput = "NEG" Then Readout = "-" & Readout
LastInput = "NUMS"
Application.CommandBars(APPNAME).Controls(1).Text = Readout
End Sub

Sub OperatorClick(Op)
' Click event procedure for operator keys (+, -, *, /, =).
Dim TempDisplay As String
Dim Msg As String
If Left(Readout, 1) = "*" Then Call ResetCalculator 'error
TempDisplay = CDbl(Readout)
If LastInput = "NUMS" Then NumOps = NumOps + 1

On Error GoTo NoCanDo
Select Case NumOps
Case 0
If Op = "-" And LastInput <> "NEG" Then
Readout = "-" & Readout
LastInput = "NEG"
End If
Case 1
Op1 = CDbl(Readout)
If Op = "-" And LastInput <> "NUMS" And OpFlag <> "=" Then
Readout = "-"
LastInput = "NEG"
End If
Case 2
Op2 = TempDisplay
Select Case OpFlag
Case "+": Op1 = CDbl(Op1) + CDbl(Op2)
Case "-": Op1 = CDbl(Op1) - CDbl(Op2)
Case "X": Op1 = CDbl(Op1) * CDbl(Op2)
Case "/": Op1 = CDbl(Op1) / CDbl(Op2)
Case "=": Op1 = CDbl(Op2)
End Select
If HasDecimal(Op1) Then Readout = Op1 Else Readout = Op1 & Application.International(xlDecimalSeparator)
NumOps = 1
End Select
If LastInput <> "NEG" Then
LastInput = "OPS"
OpFlag = Op
End If
Application.CommandBars(APPNAME).Controls(1).Text = Readout
Exit Sub
NoCanDo:
Readout = "* ERROR *"
Application.CommandBars(APPNAME).Controls(1).Text = Readout
On Error GoTo 0
End Sub

Sub ClearClick()
' Click event procedure for C (cancel) key.
Call ResetCalculator
End Sub

Sub ClearEntryClick()
' Click event procedure for CE (cancel entry) key.
Readout = "0"
DecimalFlag = False
LastInput = "CE"
Application.CommandBars(APPNAME).Controls(1).Text = Readout
End Sub

Sub PasteToCellClick()
' Put the result in the active cell
On Error Resume Next
With ActiveCell
' Save for undo
Set UndoCell = ActiveCell
UndoValue = .Value
UndoFormat = .NumberFormat
.Value = CDbl(Readout)
End With
' Move to next cell if user has that option set
If Application.MoveAfterReturn Then
Select Case Application.MoveAfterReturnDirection
Case xlDown: ActiveCell.Offset(1, 0).Activate
Case xlToRight: ActiveCell.Offset(0, 1).Activate
Case xlToLeft: ActiveCell.Offset(0, -1).Activate
Case xlUp: ActiveCell.Offset(-1, 0).Activate
End Select
End If
On Error GoTo 0
Application.OnUndo "Undo Paste From Calculator", "UndoCalculator"
End Sub

Sub ResetCalculator()
Readout = "0"
Application.CommandBars(APPNAME).Controls(1).Text = Readout
Op1 = 0
Op2 = 0
DecimalFlag = False
NumOps = 0
LastInput = "NONE"
OpFlag = " "
End Sub

Sub UndoCalculator()
' Undo the last paste operation
On Error GoTo NoCanDo
With UndoCell
.Parent.Parent.Activate
.Parent.Activate
.Activate
.Value = UndoValue
.NumberFormat = UndoFormat
End With
On Error GoTo 0
Exit Sub
NoCanDo:
MsgBox "Can't undo.", vbInformation, APPNAME
On Error GoTo 0
End Sub

Function HasDecimal(s) As Boolean
HasDecimal = InStr(s, Application.International(xlDecimalSeparator)) <> 0
End Function

Sub HelpClick()
Dim Msg As String
Msg = ""
Msg = Msg & "This Toolbar Calculator works just like a simple calculator." & vbCrLf & vbCrLf
Msg = Msg & " " & Chr(149) & " Keyboard not supported (mouse only)." & vbCrLf
Msg = Msg & " " & Chr(149) & " You cannot enter numbers directly into the result section." & vbCrLf
Msg = Msg & " " & Chr(149) & " Click 'Paste to cell' to put the result in the active cell." & vbCrLf
Msg = Msg & " " & Chr(149) & " Use Edit - Undo to restore the previous cell value." & vbCrLf
Msg = Msg & " " & Chr(149) & " The toolbar can be moved, but cannot be docked or resized." & vbCrLf
Msg = Msg & " " & Chr(149) & " The VBA code in the add-in is not protected." & vbCrLf
Msg = Msg & " " & Chr(149) & " Click the 'X' in the title bar to hide the calculator," & vbCrLf
Msg = Msg & " or use Tools - Toolbar Calculator to toggle the display." & vbCrLf
MsgBox Msg, vbInformation, APPNAME
End Sub

Sub AboutClick()
Dim Msg As String
Msg = ""
Msg = Msg & "This Toolbar Calculator was created by JWalk & Associates." & vbCrLf & vbCrLf
Msg = Msg & "This add-in file may be distributed freely, but it may not" & vbCrLf
Msg = Msg & "be sold or included with any other product." & vbCrLf & vbCrLf
Msg = Msg & "Visit 'The Spreadsheet Page' for Excel tips, macros, and downloads." & vbCrLf & vbCrLf
Msg = Msg & " " & Chr(149) & " Do you want to visit that site now?" & vbCrLf & vbCrLf
If MsgBox(Msg, vbInformation + vbYesNo, APPNAME) = vbYes Then
On Error Resume Next
ThisWorkbook.FollowHyperlink Address:="http://www.j-walk.com/ss/", NewWindow:=True
On Error GoTo 0
End If
End Sub

many thanks
Chris


[ This Message was edited by: Chris Davison on 2002-05-07 14:04 ]

[Ian Mac]

Chris,

at what point does the error occur?
how do you actually get darn thing working?

[Ian Mac]

Scratch the how do you get it to work part (it is Sunday and I'm being crap!)

I don't seem to get the error you describe.
What version of Excel are you using?
XP's seems fine.

[Mark O'Brien]

I can't get it to let me put in a number, let alone a decimal point. I think that's because for some reason the layout of the toolbar is screw-wed. I don't have a normal looking calculator at all.

I would have to bugger about with it a lot to get it sorted. (it may work better on my desktop, rather than this laptop)

[Tom Schreiner]

Where's your error?
It's working fine on my sys...

Sub DecimalClick()

' Click event procedure for decimal point (.) key.

If Left(Readout, 1) = "*" Then Call ResetCalculator

If LastInput = "NEG" Then

Readout = "-0" & Application.International(xlDecimalSeparator)

ElseIf LastInput <> "NUMS" Then

Readout = "0" & Application.International(xlDecimalSeparator)

End If

DecimalFlag = True

LastInput = "NUMS"

Application.CommandBars(APPNAME).Controls(1).Text = Readout

End Sub

[Chris Davison]

On 2002-04-28 08:29, Ian Mac wrote:
Scratch the how do you get it to work part (it is Sunday and I'm being crap!)

I don't seem to get the error you describe.
What version of Excel are you using?
XP's seems fine.

Hi Ian,

I'm on Excel 97 on both machines (home and work)

It's weird... I initally tried it about 6 months ago and it bombed so I emailed him. He suggested I'd got an older version and to retry while he looked into it. 6 months later and it still crashed from a new download.

[Chris Davison]

On 2002-04-28 08:56, TsTom wrote:
Where's your error?
It's working fine on my sys...

Sub DecimalClick()

' Click event procedure for decimal point (.) key.

If Left(Readout, 1) = "*" Then Call ResetCalculator

If LastInput = "NEG" Then

Readout = "-0" & Application.International(xlDecimalSeparator)

ElseIf LastInput <> "NUMS" Then

Readout = "0" & Application.International(xlDecimalSeparator)

End If

DecimalFlag = True

LastInput = "NUMS"

Application.CommandBars(APPNAME).Controls(1).Text = Readout

End Sub

Thanks Tom,

my error is when I click the decimal point, I get the error message per above.

to enter 345.67, I click on the 3 then the 4 then the 5 then as soon as I click on the decimal point, it crashes.

[Jack in the UK]

Chris try this one.. sod the mouse i hate mice tap the intergers in by num keypad.. its faster also esc rset...

do she now crash

[Chris Davison]

Jack....

NOT an option !!!

the reason I downloaded it was so I don't have to use the keyboard...

I hate going mouse / keyboard / mouse / keyboard

so being able to put numbers in via the mouse cuts out more keyboard use

[Jack in the UK]

Chris i know that silly we have had this telcon before but its a suggestion try it does it work, is so here i go hevay techi.. nar cant be bothered its sunday... check you PM's

OK the keyboard uses different technologies to mice, for a start dont eat cheese and drin coke tea and love coffe spilt on them.

BUT The keyboard has a chip thats a communicater to the com post address on the motherbaord so i guessing.. but the mouce opperates on com 1 so this post ONLY excepts points.. not the different keystrokes.. just to keep it smple ill stop there..

PLEASE try it....