Il problema e Questo : in Excel stò Tentando di sfruttare il VBA per riuscire a richreare una mia Calcolatrice , che tempo fà mi ero creato sfruttando sempre in Excel ma usando un Userform tale progetto .
Per qui detto questo : Tale mio Listato devo dire che funziona molto be tranne che un piccolo Particolare , che ogni qual volta io premo la cella corrispondente al numero 1 anzicheè il numero 2 ecc...! sul mio Displai chiamato Schermo , mi compare sempre il numero Doppio Rispetto da me Selezionato : Esempio anzichè scrivere ( 1 ) mi scrive il Numero ( 11 ) oppure per il ( 2 ) mi scrive il Numero ( 22 ) e cosi via ! Tutto questo mi Sapreste dire il perchè , e come posso fare per risolvere questo mio problema ?
Faccio anche notare che : per richiamare le varie Funzioni sono stato obbligato ad inserire il Segno Separatore cioè questo ( & ) in quanto il Classico seno di ( = ) non mi fà identificare assolutamente nulla , e anche questo mi piacerebbe capire il perchè .
Il mio listato e questo :
- Codice: Seleziona tutto
Option Explicit
'##################################
Dim I As Integer
Dim K As Integer
Dim Tx As Integer
Dim Ty As Integer
'##################################
Dim F As Byte
Dim Y As Byte
Dim OP As Boolean
Dim Zona
Dim Vcell
Dim Numeratore(1 To 6) As Long
Dim S As Integer
Dim Temporaneo As String
Dim Temp As Single
Dim lunghezza As Byte
Dim Divisione As Boolean
Dim Adizione As Boolean
Dim Sottrazione As Boolean
Dim Moltiplicazione As Boolean
Dim Punto As Boolean
Dim Memoria As Single
Dim Somma As Single
'###################################
Dim Keuro As Boolean
Dim KLire As Boolean
Dim FileName As String
Dim KPercent As String
Dim Target(1 To 25) As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
'Routine che serve Per dare La Possibilità al Giocatore di _
Selezionare i Numeri che Formeranno la Calcolatrice per lo _
Svolgimento del Gioco Usando semplicemente il Mouse
Application.Calculate
Application.Volatile
Set Zona = Range("C5:G9")
If Not Intersect(Target, Zona) Is Nothing Then
Vcell = Target.Value
Target.Interior.ColorIndex = 6
If Range("B1") <> "" Then
Range("A1").End(xlToLeft).Offset(0, 1).Value = Vcell '.Select
Else
Range("A1").Value = Vcell
End If
Cells(0, 1).Select
End If
If Not (Target = "$C$5" Or Target = "$D$5" Or Target = "$E$5" _
Or Target = "$C$6" Or Target = "$D$6" Or Target = "$E$6" _
Or Target = "$C$7" Or Target = "$D$7" Or Target = "$E$7" _
Or Target = "$D$8" Or Target = "$F$5" Or Target = "$F$6" _
Or Target = "$F$7" Or Target = "$F$8" Or Target = "$F$9" _
Or Target = "$C$9" Or Target = "$D$9" Or Target = "$E$9" _
Or Target = "$G$5" Or Target = "$G$6" Or Target = "$G$7" _
Or Target = "$G$8" Or Target = "$G$9" Or Target = "$C$8" _
Or Target = "$E$8") Then
Range("C4").Value = Foglio1.Schermo.Text = Int("")
Select Case Target
Case Is = "0"
If Foglio1.Schermo.Text & Str("0") Then
Zero_Click
End If
Case 1
If Foglio1.Schermo.Text & ("1") Then
Uno_Click
End If
Case 2
If Foglio1.Schermo.Text & "2" Then
Due_Click
End If
Case 3
If Foglio1.Schermo.Text & "3" Then
Tre_Click
End If
Case 4
If Foglio1.Schermo.Text & "4" Then
Quattro_Click
End If
Case 5
If Foglio1.Schermo.Text & "5" Then
Cinque_Click
End If
Case 6
If Foglio1.Schermo.Text & "6" Then
Sei_Click
End If
Case 7
If Foglio1.Schermo.Text & "7" Then
Sette_Click
End If
Case 8
If Foglio1.Schermo.Text & "8" Then
Otto_Click
End If
Case 9
If Foglio1.Schermo.Text & "9" Then
Nove_Click
End If
Case Is = "+"
If Foglio1.Schermo.Text & ("+") Then
Piu_Click
End If
Case Is = "-"
If Foglio1.Schermo.Text & ("-") Then
Meno_Click
End If
Case Is = "*"
If Foglio1.Schermo.Text & ("*") Then
Per_Click
End If
Case Is = "/"
If Foglio1.Schermo.Text & ("/") Then
Diviso_Click
End If
Case Is = "%"
If Foglio1.Schermo.Text & ("%") Then
Percentuale_Click
End If
Case Is = "£"
If Foglio1.Schermo.Text & ("£") Then
Lira_Click
End If
Case Is = "€"
If Foglio1.Schermo.Text & ("€") Then
Euro_Click
End If
Case Is = "^"
If Foglio1.Schermo.Text & ("^") Then
ElevatoPotenza_Click
End If
Case Is = "C"
If Foglio1.Schermo.Text & ("C") Then
Cancella_Click
End If
Case Is = "<=="
If Foglio1.Schermo.Text & ("<==") Then
Rientro_Click
End If
Case Is = "Copy"
If Foglio1.Schermo.Text & ("Copy") Then
Memorizza_Click
End If
Case Is = "Reset"
If Foglio1.Schermo.Text & ("Reset") Then
Stampa_Click
End If
Case Is = "?"
If Foglio1.Schermo.Text & ("?") Then
RadiceQuadrata_Click
End If
Case Is = "."
If Foglio1.Schermo.Text & (".") Then
Virgola_Click
End If
Case Is = "="
If Foglio1.Schermo.Text & ("=") Then
Uguale_Click
End If
End Select
End If
Foglio1.Schermo.Activate
Range("A1").Select
End Sub
Sub Cancella_Click()
'On Error Resume Next
Frm_CancellaDati.Show
Temp = 0
Moltiplicazione = False
Adizione = False
Divisione = False
Sottrazione = False
OP = False
Foglio1.Schermo.Text = ""
Foglio1.Range("A1").Value = ""
Foglio1.Range("C4").Value = ""
Range("A1").Select
End Sub
Sub Chiudi_Click()
'On Error Resume Next
Unload Me
End Sub
Sub Cinque_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "5"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "5"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Diviso_Click()
'On Error Resume Next
If Divisione = True Then
If CDbl(Foglio1.Schermo.Text) > 0 Then
Somma = Temp / CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Else
MsgBox "Impossibile dividere per 0", vbCritical, "Errore"
End If
Divisione = False
OP = False
End If
If Adizione = True Then
Somma = CDbl(Foglio1.Schermo.Text) + Temp
Foglio1.Schermo.Text = CStr(Somma)
Adizione = False
OP = False
End If
If Sottrazione = True Then
Somma = Temp - CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Sottrazione = OP = False
End If
If Moltiplicazione = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Moltiplicazione = False
OP = False
End If
Temp = CDbl(Schermo.Text)
Divisione = True
OP = True
Foglio1.Schermo.SetFocus
End Sub
Sub Due_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "2"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "2"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.Activate
End Sub
Sub ElevatoPotenza_Click()
'On Error Resume Next
If Foglio1.Schermo.Text <> "" Then
Foglio1.Schermo.Text = q(CDbl(Foglio1.Schermo.Text))
End If
End Sub
Sub Euro_Click()
'On Error Resume Next
Const Keuro = 1936.27
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = Format(Foglio1.Schermo / Keuro, "#.##0,00")
Else
Foglio1.Schermo.Text = Format(Foglio1.Schermo / Keuro, "#.##0,00")
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Frame1_Click()
End Sub
Sub Lira_Click()
'On Error Resume Next
Const KLire = 1936.27
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = Format(Foglio1.Schermo * KLire, "0,00")
Else
Foglio1.Schermo.Text = Format(Foglio1.Schermo * KLire, "0,00")
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Memorizza_Click()
On Error Resume Next
Trasferimento_Dati_Click
End Sub
Sub Meno_Click()
'On Error Resume Next
If Divisione = True Then
If CDbl(Foglio1.Schermo.Text) > 0 Then
Somma = Temp / CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Else
MsgBox "Impossibile dividere per 0", vbCritical, "Errore"
End If
Divisione = False
OP = False
End If
If Adizione = True Then
Somma = CDbl(Foglio1.Schermo.Text) + Temp
Foglio1.Schermo.Text = CStr(Somma)
Adizione = False
OP = False
End If
If Sottrazione = True Then
Somma = Temp - CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Sottrazione = OP = False
End If
If Moltiplicazione = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Moltiplicazione = False
OP = False
End If
Temp = CDbl(Foglio1.Schermo.Text)
Sottrazione = True
OP = True
Foglio1.Schermo.SetFocus
End Sub
Sub Nove_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "9"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "9"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Otto_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "8"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "8"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Per_Click()
'On Error Resume Next
If Divisione = True Then
If CDbl(Foglio1.Schermo.Text) > 0 Then
Somma = Temp / CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Else
MsgBox "Impossibile dividere per 0", vbCritical, "Errore"
End If
Divisione = False
OP = False
End If
If Adizione = True Then
Somma = CDbl(Foglio1.Schermo.Text) + Temp
Foglio1.Schermo.Text = CStr(Somma)
Adizione = False
OP = False
End If
If Sottrazione = True Then
Somma = Temp - CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Sottrazione = OP = False
End If
If Moltiplicazione = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Moltiplicazione = False
OP = False
End If
Temp = CDbl(Foglio1.Schermo.Text)
Moltiplicazione = True
OP = True
Foglio1.Schermo.SetFocus
End Sub
Sub Percentuale_Click()
'On Error Resume Next
Const KPercent = 100
'#######################################################
If Percentuale = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Percentuale = False
OP = False
End If
'#######################################################
Foglio1.Schermo.Text = Format(Somma / KPercent, "0.#,0")
Foglio1.Schermo.SetFocus
End Sub
Private Sub Picture1_DblClick()
'On Error Resume Next
tmHor.Enabled = True
End Sub
Sub Piu_Click()
'On Error Resume Next
If Divisione = True Then
If CDbl(Foglio1.Schermo.Text) > 0 Then
Somma = Temp / CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Else
MsgBox "Impossibile dividere per 0", vbCritical, "Errore"
End If
Divisione = False
OP = False
End If
If Adizione = True Then
Somma = CDbl(Foglio1.Schermo.Text) + Temp
Foglio1.Schermo.Text = CStr(Somma)
Adizione = False
OP = False
End If
If Sottrazione = True Then
Somma = Temp - CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Sottrazione = OP = False
End If
If Moltiplicazione = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Moltiplicazione = False
OP = False
End If
Temp = CDbl(Foglio1.Schermo.Text)
Adizione = True
OP = True
Foglio1.Schermo.SetFocus
End Sub
Sub Quattro_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "4"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "4"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub RadiceQuadrata_Click()
'On Error Resume Next
Foglio1.Schermo.Text = Sqr(CDbl(Foglio1.Schermo.Text))
Foglio1.Schermo.SetFocus
End Sub
Sub Rientro_Click()
'On Error Resume Next
If Foglio1.Schermo.Text <> "" And Foglio1.Schermo.Text <> "0" Then
Temporaneo = Foglio1.Schermo.Text
Foglio1.Schermo.Text = ""
lunghezza = Len(Temporaneo)
For F = 1 To lunghezza - 1 Step 1
Foglio1.Schermo.Text = Foglio1.Schermo.Text & Mid(Temporaneo, F, 1)
Next F
End If
Foglio1.Schermo.SetFocus
End Sub
Private Sub Schermo_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'On Error Resume Next
'Codice di Controllo che Indica Al Programma Quale tasto si e' Premuto il Quel Momento
Select Case Chr(KeyAscii)
Case "+"
Piu_Click
'''''''''''''''''''''''''''''
Case "*"
Per_Click
'''''''''''''''''''''''''''''
Case "/"
Diviso_Click
'''''''''''''''''''''''''''''
Case "-"
Meno_Click
'''''''''''''''''''''''''''''
Case ","
Virgola_Click
'''''''''''''''''''''''''''''
Case "."
Virgola_Click
'''''''''''''''''''''''''''''
Case "0"
Zero_Click
'''''''''''''''''''''''''''''
Case "1"
Uno_Click
'''''''''''''''''''''''''''''
Case "2"
Due_Click
'''''''''''''''''''''''''''''
Case "3"
Tre_Click
'''''''''''''''''''''''''''''
Case "4"
Quattro_Click
'''''''''''''''''''''''''''''
Case "5"
Cinque_Click
'''''''''''''''''''''''''''''
Case "6"
Sei_Click
'''''''''''''''''''''''''''''
Case "7"
Sette_Click
'''''''''''''''''''''''''''''
Case "8"
Otto_Click
'''''''''''''''''''''''''''''
Case "9"
Nove_Click
'''''''''''''''''''''''''''''
Case "10"
ElevatoPotenza_Click
''''''''''''''''''''''''''''''
Case "11"
RadiceQuadrata_Click
''''''''''''''''''''''''''''''
Case "12"
Percentuale_Click
''''''''''''''''''''''''''''''
Case "13"
Rientro_Click
''''''''''''''''''''''''''''''
Case "14"
Memorizza_Click
''''''''''''''''''''''''''''''
Case "15"
Chiudi_Click
''''''''''''''''''''''''''''''
Case "16"
Cancella_Click
''''''''''''''''''''''''''''''
Case "17"
Memorizza_Click
'##############################
End Select
If KeyAscii = 13 Then
Uguale_Click
End If
KeyAscii = 0
End Sub
Sub Sei_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "6"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "6"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Sette_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "7"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "7"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Stampa_Click()
On Error Resume Next
End Sub
Sub Tre_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "3"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "3"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Uguale_Click()
'On Error Resume Next
If Divisione = True Then
If CDbl(Foglio1.Schermo.Text) > 0 Then
Somma = Temp / CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Else
MsgBox "Impossibile dividere per 0", vbCritical, "Errore"
End If
Divisione = False
OP = False
End If
If Adizione = True Then
Somma = CDbl(Foglio1.Schermo.Text) + Temp
Foglio1.Schermo.Text = CStr(Somma)
Adizione = False
OP = False
End If
If Sottrazione = True Then
Somma = Temp - CDbl(Foglio1.Schermo.Text)
Foglio1.Schermo.Text = CStr(Somma)
Sottrazione = OP = False
End If
If Moltiplicazione = True Then
Somma = CDbl(Foglio1.Schermo.Text) * Temp
Foglio1.Schermo.Text = CStr(Somma)
Moltiplicazione = False
OP = False
End If
'MacroNumeroCalcolato
Foglio1.Schermo.SetFocus
End Sub
Sub Uno_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
If lunghezza < 32 Then
If Foglio1.Schermo.Text = "0" Then
Foglio1.Schermo.Text = "1"
Else
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "1"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.Activate
End Sub
Sub UserForm_activate()
'On Error Resume Next
Me.Caption = " " & Time & " " & Date
End Sub
Sub UserForm_Resize()
'On Error Resume Next
Me.Height = 296.25
Me.Width = 274.5
End Sub
Sub Virgola_Click()
'On Error Resume Next
If lunghezza < 32 Then
lunghezza = Len(Foglio1.Schermo.Text)
For F = 1 To lunghezza Step 1
If Mid(Foglio1.Schermo.Text, F, 1) = "," Then
Virgola = True
End If
Next F
If Virgola = False And Foglio1.Schermo.Text <> "" Then
Foglio1.Schermo.Text = Foglio1.Schermo.Text & ","
Else
If Foglio1.Schermo.Text = "" Then
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "0,"
Else
Beep
End If
End If
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Zero_Click()
'On Error Resume Next
If OP = True Then
Foglio1.Schermo.Text = ""
End If
lunghezza = Len(Foglio1.Schermo.Text)
If lunghezza < 32 Then
If Foglio1.Schermo.Text <> "0" Then
Foglio1.Schermo.Text = Foglio1.Schermo.Text & "0"
End If
OP = False
Else
Beep
End If
Foglio1.Schermo.SetFocus
End Sub
Sub Trasferimento_Dati_Click()
On Error Resume Next
Range("C4").Value = Numeratore(I)
I = I + 1
If I > 6 Then
I = 1
'End If
Numeratore(1) = 1
Numeratore(2) = 2
Numeratore(3) = 3
Numeratore(4) = 4
Numeratore(5) = 5
Numeratore(6) = 6
Numeratore(7) = 7
If Numeratore(11) = 11 Then
Foglio1.Range("H4:H9").Value = ""
End If
End If
Range("H4").Value = Numeratore(I)
Trasferimento_Dati_Foglio1
End Sub
Vi Ringrazio sin da Ora per tutti i consigli e l'aiuto che riuscirete a darmi in merito , fosse anche solo parziale , Sinceri saluti da Maurizio
EDIT Flash ore 01:08 - Inserito il codice nel Tag CODE
Avviso a tutti gli utenti: Quando si posta un codice VBA è opportuno usare il Tag CODE cliccando nel Tag Code dell'Editor del post