INVIO automatico alla digitazione di certi tasti

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

No, tu digiti in A1 AM1 e premi invio

Questo passaggio, che e' fondamentale, mi era sfuggito.

Grazie scossa per il chiarimento.

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Private Sub Worksheet_Activate()

Dim cella As Range
    Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(ActiveSheet.Name)
For Each cella In RM.Range("H95:H100")
     Application.OnKey "+" & cella, "onkey_" & cella
Next
End Sub

Function onkey_C()
'If ActiveSheet.Name = "Foglio1" And Not Intersect(ActiveCell, Range("A1:A20")) Is Nothing Then
'        ActiveCell = "M"
'    Else
'        Application.SendKeys ("{F2}{HOME}M")
    'Application.SendKeys ("M[Enter}")
'    End If
Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(ActiveSheet.Name)
    XRIG = ActiveCell.Row
    XCOL = ActiveCell.Column
    Range(ActiveCell.Address) = "C"
    RM.Cells(XRIG + 1, XCOL).Select
    'Application.SendKeys ("{F2}{HOME}C")
End Function

Brutalmente: Funziona! (scavalcato Sendkeys, che non funziona sciolto MacOS) sostituito con lo spostamento del cursore.

 

 

 

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Solo per le le lettere previste, ovviamente ...

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Si' ma non e' la soluzione come l'hanno pensata scossa e dsw e che probabilmente aderisce di piu' al tuo quesito, che forse non avevo capito bene.

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Buongiorno, intanto grazie a tutti per il vostro interesse

Allora, per quanto mi riguarda il problema è stato risolto perfettamente ... con "onKey", grazie Vecchio Frac, era proprio la soluzione giusta per le mie esigenze che erano quelle di evitare di digitare anche il tasto ENTER ogni volta che digitavo certe lettere (di un carattere, numeri esclusi), cioè:

invece di

A {ENTER} C {ENTER} M {ENTER} 2,5 {ENTER} R {ENTER} ecc.

digitare

A C M 2,5 {ENTER} R ecc.

una bella differenza, ovvero, nell'esempio, dopo le lettere A C M R l'{ENTER} viene inserito automaticamente con il cursore si sposta, nella cella successiva.

Il codice VBA sviluppato:

Nel Foglio 01:

Private Sub Worksheet_Deactivate()
    Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(Me.Name)
    RM.Activate
    Call ZRMX
Dim XCEL As Range
For Each XCEL In RM.Range(RMCC)
If Len(XCEL) = 1 Then
    Application.onkey "+" & XCEL
End If
Next
    Set RA = Workbooks(ActiveWorkbook.Name).Worksheets("ANNO")
    RA.Unprotect
    RA.Range("F4") = "M"
    RA.Protect
    RA.Activate
    RM.Unprotect
    RM.Range("J31").Font.ColorIndex = 3
    RM.Protect
End Sub

Nel Modulo1:

Sub ONKEY_UP()
    Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(ActiveSheet.Name)
    Call ZRMX
Dim XCEL As Range
For Each XCEL In RM.Range(RMCC)
If Len(XCEL) = 1 Then
    Application.onkey "+" & XCEL, "ONKEY_" & XCEL
End If
Next
    Set RA = Workbooks(ActiveWorkbook.Name).Worksheets("ANNO")
    RA.Unprotect
    RA.Range("F4") = "A"
    RA.Protect
    RM.Activate
    RM.Unprotect
    RM.Range("J31").Font.ColorIndex = 1
    RM.Protect
End Sub
Sub ONKEY_DOWN()
    Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(ActiveSheet.Name)
    Call ZRMX
Dim XCEL As Range
For Each XCEL In RM.Range(RMCC)
If Len(XCEL) = 1 Then
    Application.onkey "+" & XCEL
End If
Next
    Set RA = Workbooks(ActiveWorkbook.Name).Worksheets("ANNO")
    RA.Unprotect
    RA.Range("F4") = "M"
    RA.Protect
    RM.Activate
    RM.Unprotect
    RM.Range("J31").Font.ColorIndex = 3
    RM.Protect
End Sub

Sub ONKEY_F()
    XCOD = "F"
    Call ONKEY_
End Sub
Sub ONKEY_R()
    XCOD = "R"
    Call ONKEY_
End Sub
Sub ONKEY_M()
    XCOD = "M"
    Call ONKEY_
End Sub
Sub ONKEY_x()
    XCOD = "x"
    Call ONKEY_
End Sub
Sub ONKEY_A()
    XCOD = "A"
    Call ONKEY_
End Sub
Sub ONKEY_C()
    XCOD = "C"
    Call ONKEY_
End Sub
Sub ONKEY_()
Dim XRIG As Integer
Dim XCOL As Integer
Dim ZRIG As Integer
Dim ZCOL As Integer
    Set RA = Workbooks(ActiveWorkbook.Name).Worksheets("ANNO")
    Set RM = Workbooks(ActiveWorkbook.Name).Worksheets(ActiveSheet.Name)
 If ActiveSheet.Name <> "ANNO" Then
    Call ZRMX
 If Not Application.Intersect(ActiveCell, RM.Range(RMAC)) Is Nothing Then

    XRIG = ActiveCell.Row
    XCOL = ActiveCell.Column
    ActiveCell = XCOD
    
    ZRIG = Right(RM.Range(RMZE), 2)
    ZCOL = Left(RM.Range(RMZE), 2)
If ZRIG <> 0 Then
If RM.Cells(11, XCOL) <> "" Then
    RM.Cells(ZRIG, ZCOL) = UCase(RM.Cells(ZRIG, ZCOL)) & RM.Cells(11, ZCOL)
End If
End If

If RA.Range("E4") = "V" Then
If RM.Range("F" & XRIG + 1) <> "" Then
    RM.Cells(XRIG + 1, XCOL).Select
Else
    RM.Cells(RM.Range(RMXC).Row, XCOL + 1).Select
End If
Else
If RM.Cells(13, XCOL + 1) <> "" Then
    RM.Cells(XRIG, XCOL + 1).Select
Else
    RM.Cells(XRIG + 1, RM.Range(RMXC).Column).Select
End If
End If
Else
On Error Resume Next
    ActiveCell = XCOD
On Error GoTo 0
End If '***Intersect
Else
On Error Resume Next
    ActiveCell = XCOD
On Error GoTo 0
End If '*** ANNO
End Sub

allego l'intero progetto.

Grazie a tutti, se occorrono chiarimenti (per i "principianti", come me) fatemelo sapere.

Vecchio frac: la soluzione da te proposta era quella giusta, è bastato usare la Select invece di sendkeys (che, tra l'altro, non funziona in MACOS) ma in ogni caso è meglio.

Ho ammirato (e invidiato) molto tutta la vostra discussione, siete davvero formidabili.

Abramo

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Grazie del feedback e della condivisione   

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Solo una curiosità:

non sono ad utilizzare il tasto control (^) né il tasto Alt (%) né il tasto Command (MAC *).

Funziona solo con il tasto Shift (+) ???

Ma non ci ho voluto perdere molto tempo ... strano però ... noo?

Certo ora riportare i codici nel foglio Excel è ... na' favola ... metà tempo!

E ho scoperto anche me.

Come farei senza di voi!

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Me stesso
La parola chiave Me consente di fare riferimento alla worksheet (Worksheets(Me.Name) in cui il codice è attualmente in esecuzione.

Altrimenti non c'era modo di disattivare onKey al momento dell'uscita (Deactivate) dal foglio in cui era attivato.

Perché come si attivava l'evento Deactivate il foglio attivo diventa immediatamente il nuovo foglio e si perdeva la nozione di quello da cui eravamo usciti e "dove" dovevamo fare la disattivazione di onKey ciclando sui codici della sua tabella, come avevamo fatto per attivarlo.

Vedi più sopra il codice VBA inserito.

Se qualche "principiante", com me, vuole divertirsi  a vedere come funziona l'onKey, basta che scarichi l'intero progetto e poi nel foglio 01 (Gennaio) provi ad attivare o disattivare l'onKey cliccando sui tasti opportuni in basso a destra (A) (M) e vedrà la differenza (il tasto di controllo è Shift).

Dovrebbe funzionare anche sotto windows o almeno io l'ho progettato così, poi ...

 

[scossaPartecipante scossa Karma: 37 pts]

Ciao,

giusto per completezza posto il codice necessario per inserire in un'unica inputbox tutti i codici della colonna, con la sola accortezza di separare due codici interi consecutivi con un più.

La sub si attiva al doppio clic su una cella delle righe 13 o 14 e si occupa di aggiungere anche eventuali suffissi F/M.

in un modulo standard:

Function fSplit(ByVal sChars As String) As Variant
    Dim rx As Object
    Dim ma As Object
    Dim vRet As Variant
    Dim j As Long
    
    Set rx = CreateObject("vbscript.regexp")
    With rx
        .Global = True
        .Pattern = "([a-zA-Z]{1})|(-?[0-9]{1,2},[0-5]{1})|(-?[0-9]{1,2})|(\.)"
        Set ma = .Execute(sChars)
    End With
    ReDim vRet(0 To ma.Count - 1)
    For j = 0 To UBound(vRet)
      vRet(j) = ma.Item(j)
    Next j
    fSplit = vRet
    Set rx = Nothing
    Set ma = Nothing

End Function

nel modulo di ThisWorkbook (evento DoppioClick):

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim aStr As Variant
  Dim j As Long
  Dim bFest As Boolean, bMer As Boolean
  Dim sString As String, sChar As String, sPrompt As String
  
  If Not Intersect(Target(1, 1), Sh.Range("H13:AL14")) Is Nothing Then
    If Target.Row = 13 Then
      Set Target = Target(1, 1)
    Else
      Set Target = Target(0, 1)
    End If
    If Target(0, 1).Text = "Fes" Then bFest = True
    If Target(0, 1).Text = "Mer" Then bMer = True
    sPrompt = "inserisci i dati" & IIf(bFest, " (Festivo)", IIf(bMer, " (Mercoledì)", ""))
    sString = Application.InputBox(sPrompt, Format(Target.Offset(-3), "ddd dd mmm yyyy"), Type:=2)
    If sString <> "Falso" Then
      aStr = fSplit(sString)
      With Target(4, 1)
        Application.EnableEvents = False
        .Resize(10).ClearContents
        For j = 0 To UBound(aStr)
          sChar = UCase(aStr(j))
          .Offset(j).Value = sChar & IIf(InStr("AC", sChar), IIf(bFest, "F", IIf(bMer, "M", "")), "")
        Next j
        Application.EnableEvents = True
      End With
    End If
  End If

End Sub

Ad esempio

per Dom 1 Dic.: doppio clic su H13 (o H14) ed inserire nella InputBox:.CMA-2,5..e premere invio

per Lun 30 dic: doppio clic su AK13 (AK14) ed inserire-2,501macfa(o-2,51macfa)  e premere invio

Allego il file di dicembre così rivisto.

 

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

E' certamente una soluzione piu' pulita.   

[ABRAMO48Partecipante ABRAMO48 Karma: 1 pt]

Signori,

mi potete suggerire un libro o quant'altro per imparare ad usare excel+VBA al vostro livello?

Ne ho visti alcuni su Amazon, ma un vostro consiglio sarebbe molto utile ...

O avete un'altra idea?

Grazie carissimi !!!

[Autore]

Articoli