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 = "ButtonClick"
If Not IsMissing(tooltip) Then .TooltipText = tooltip
If caption = "" Then .Enabled = False
End With
End Sub

Sub ButtonClick()
' 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

 

[Joe Was]

This is not J-Walker's calculator, but it works. This code pulls the windows default calculator. The code is written to work with a hot-key or form button. It could be made to work as a tool-bar add-in. JSW

Sub myCal()
'Open the Windows Calculator.
Dim RetVal
RetVal = Shell("C:WINDOWSCALC.EXE", 1)
End Sub
This message was edited by Joe Was on 2002-04-30 08:16

 

[Von Pookie]

Or, you could just put a button on the toolbar for the windows calculator an easier way...

 

[Jack in the UK]

Chris

Sorry my old mate., very behind.. the comments re button to click YUCK!\the reason i asked was it the key inut works i would say its faster and advanced mode does Hex dec and all you need and is free and in windows..

the calculator add to system tray.. not in excel.. no point adding to excel

I even have JAVA calculator that DHTML opening and sweet vcopy paste and all all key input.

all account bar your self use this method.. so i trust you have reasons but advise this method.

but again its what ever your happy with thats important...

I do not like adding toobars thats all.. again my way.

unless she yellow with pink hair!

 

[Chris Davison]

On 2002-04-28 14:10, brettvba wrote:
I have found that code seems to change from version to version of excel i have xp and that code works fine , have you tried debuging the code to see where the error is?

Gidday Brett,

yeah... I got the same error position as Ian

 

[Chris Davison]

On 2002-04-30 04:22, Ian Mac wrote:
Ok then,

All,

I tried this with XL97 and did indead get an error, it occurs at this point:

Sub ButtonClick()
' 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

any ideas anyone?

thanks for this Ian... good to know I'm not totally bonkers !!!

 

[Chris Davison]

On 2002-04-30 07:21, JasonLee wrote:
Change the code on the ButtonClick sub to this and it works like a charm. It is a type mismatch error. I think the "." key is translated to a value of 3 and that Case statement grabs it but then it's like hey this is really Text and not a number. Anyway the code below works.

Sub ButtonClick()
' 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 Application.International(xlDecimalSeparator): Call DecimalClick
Case "+", "-", "X", "/", "=": Call OperatorClick(Btn)
Case "C": Call ClearClick
Case "CE": Call ClearEntryClick
Case "Paste to cell": Call PasteToCellClick
Case 0 To 9: Call NumberClick(Btn)
End Select
End Sub

Jason, thanks.... I shall paste this in tommorrow at work

*fingers crossed*

 

[Chris Davison]

On 2002-04-30 08:38, Von Pookie wrote:
Or, you could just put a button on the toolbar for the windows calculator an easier way...

Joe / Kristy,

thanks for the suggestions

I had been using the windows calculator, but to get the numbers into Excel meant clicking on copy, then pasting in Excel

JWalk's calculator does this with a single click which is why it appealed to me...

(I'm an accountant so the difference between a single and a double mouse click maybe 10,000 times a day can add up to a nice time-saver !!!)

cheers guys
much appreciated

 

[Chris Davison]

On 2002-04-30 14:49, Jack in the UK wrote:
Chris

Sorry my old mate., very behind.. the comments re button to click YUCK!the reason i asked was it the key inut works i would say its faster and advanced mode does Hex dec and all you need and is free and in windows..

the calculator add to system tray.. not in excel.. no point adding to excel

I even have JAVA calculator that DHTML opening and sweet vcopy paste and all all key input.

all account bar your self use this method.. so i trust you have reasons but advise this method.

but again its what ever your happy with thats important...

I do not like adding toobars thats all.. again my way.

unless she yellow with pink hair!

no worries Jack !! all help gratefully appreciated

 

[Chris Davison]

Good stuff Jason... it works perfectly now



thanks to everyone else for your respective help too

 

[Jack in the UK]

Chris

A lot of effort was put in buy guys and yourself, i have spent all day at work as you finance and YES i totally agree, transfreing the data is a pain, this to works and so i pass on thanks top all the guys.