Print side | Luk vindue

Kode - Husk position

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3741
Udskrevet den: 23.Nov.2024 kl. 10:22


Emne: Kode - Husk position
Besked fra: Ib Hansen
Emne: Kode - Husk position
Posteringsdato: 07.Jan.2019 kl. 12:17
Hej Forum

- Jeg har en kode direkte i Sheets("Ark1").
- Koden aktiveres, hvis der tastes en separator i et klokkeslæt, hvilket man ikke må.
- Koden hopper Offset(-1, 0) op til cellen og sletter det indtastede, hvorefter der kommer MsgBox.
- Men det er kun hvis Enter tasten bruges, den hopper Offset op.

Det jeg søger er en kode, der husker sidste position og hopper tilbage til den og sletter det indtastede.
Dette da man kan bruge pil-tasterne i stedet for Enter-tasten og hvis f.eks. Pil-højre bruges, hopper den til højre i stedet for nedad og sletter Offset cellen oven over.
Det dutter ette Angry

Koden det drejer som om, er mærket med rødt.
On Error Resume Next
 ActiveCell.Offset(-1, 0).Select: Selection = ""
'Dialog Message
         QuestionToMessageBox = "   Ugyldig indtastning !" _
        & vbNewLine & vbNewLine & "   Der er enten brugt separator." _
        & vbNewLine & "   Eller det er et ugyldigt klokkeslæt." _
        & vbNewLine & vbNewLine & "   Skriv et korrekt klokkeslæt, som et helt tal, uden separator." _
        & vbNewLine & "   -  1        =   00:01" _
        & vbNewLine & "   -  12      =   00:12" _
        & vbNewLine & "   -  123    =   01:23" _
        & vbNewLine & "   -  1234  =   12:34" _
        & vbNewLine & vbNewLine & "   Midnat, klokken 24:00, skrives altid som 0." _
        & vbNewLine & "   -  0        =   24:00"
'MsgBox Title
        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbOKOnly + vbInformation, "")

På forhånd tak

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)


Svar:
Besked fra: EXCELGAARD
Posteringsdato: 07.Jan.2019 kl. 15:04
Hvis du ligger koden ind i 'Worksheet_Change' eventen, så vil objektet 'Target' altid indholde cellen, som sidst er blevet ændret...
...denne kan du så benytte. 
Target.Select
Target.Value = ""



-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: EXCELGAARD
Posteringsdato: 07.Jan.2019 kl. 15:06
Kom lige til at se...

Vil det ikke være bedre, at benytte data validering til at teste for dette?
Og, dermed undgå for meget kode og for mange events?

Bare sæt data valideringen til et helt tal mellem 0 og 2400 (evt. 2359)

Så er den ged barberet, og bruger kan slet ikke indtaste et klokkeslet med et kolon.



-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: Ib Hansen
Posteringsdato: 07.Jan.2019 kl. 15:14
Hej Excelgaard

Jeg fandt selv løsningen, før jeg så dit svar TongueLOL
Men jeg kan desværre ikke selv markerer tråden som "Løst" Disapprove

uploads/1125/Løst_-_Klokkeslæts_kode.xlsm" rel="nofollow - Test ark

Her er hele tidskoden, der er indsat i Sheets("Ark1").
Løsning med rødt.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'----------------------------------------------------------------------------------
'*' Tast klokkeslæt direkte i cellerne.
'*' Kopier koden og indsæt den direkte under det ark den skal bruges.
'*' I linje 3 nedenunder skal Sheets() og Range("") tilpasses.
'*' Der kan tilføjes flere Range efter behov.
'*' Brug komma som separator ved flere Range = Range("N9:P487, R9:S487, U9:V487").
'*' Formater cellerne, hvor klokkeslættene skal tastes, som Klokkeslætsformat.

'*' Se også det med grønt nederst i koden vedr. Password.
'----------------------------------------------------------------------------------
    On Error GoTo EndMacro
    If Intersect(Target, Sheets("Forside").Range("D17:E398, G7:H398")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    With Target
        If .HasFormula = False Then
             Select Case Len(.Value)
                 Case 1 ' e.g., 1 = 00:01 AM
                     TimeStr = "00:0" & .Value
                 Case 2 ' e.g., 12 = 00:12 AM
                     TimeStr = "00:" & .Value
                 Case 3 ' e.g., 735 = 7:35 AM
                     TimeStr = Left(.Value, 1) & ":" & Right(.Value, 2)
                 Case 4 ' e.g., 1234 = 12:34
                     TimeStr = Left(.Value, 2) & ":" & Right(.Value, 2)
                 Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
                     TimeStr = Left(.Value, 1) & ":" & Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
                 Case 6 ' e.g., 123456 = 12:34:56
                     TimeStr = Left(.Value, 2) & ":" & Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
                 Case Else
                      Err.Raise 0
             End Select
             .Value = TimeValue(TimeStr)
        End If
    End With
        Application.EnableEvents = True
    Exit Sub
 
EndMacro:
     On Error Resume Next
     Range(Target.Address).Select: Selection = ""
 'Dialog Message
         QuestionToMessageBox = "   Ugyldig indtastning !" _
        & vbNewLine & vbNewLine & "   Der er enten brugt separator." _
        & vbNewLine & "   Eller det er et ugyldigt klokkeslæt." _
        & vbNewLine & vbNewLine & "   Skriv et korrekt klokkeslæt, som et helt tal, uden separator." _
        & vbNewLine & "   -  1        =   00:01" _
        & vbNewLine & "   -  12      =   00:12" _
        & vbNewLine & "   -  123    =   01:23" _
        & vbNewLine & "   -  1234  =   12:34" _
        & vbNewLine & vbNewLine & "   Midnat, klokken 24:00, skrives altid som 0." _
        & vbNewLine & "   -  0        =   24:00"
'MsgBox Title
        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbOKOnly + vbInformation, "")

'----------------------------------------------------------------------------------
'*' Hvis der bruges Password, skal Password skrives i koden nedenunder.
'*' Password indsættes 2 steder.
'*' 1) Hvor arket låses op.
'*' 2) Hvor arket låses igen.
'*' Eks hvis Password = Hej -> ActiveSheet.Unprotect Password:="Hej"
'*' Eks hvis Password = Hej -> ActiveSheet.Protect Password:="Hej"

'*' Hvis arket låses, men UDEN Password, skal der ikke ændres i koden.
'*' Koden skal heller ikke ændres, hvis der IKKE bruges Password.
'*' Her bruges bare tomme tegn.
'*' Eks -> ActiveSheet.Unprotect Password:=""
'*' Eks -> ActiveSheet.Protect Password:=""
'----------------------------------------------------------------------------------
UD:
Rem    ActiveSheet.Unprotect Password:=Sheets("Indstillinger").Range("B9").Value
Rem    ActiveCell.NumberFormat = "hh:mm"
Rem    ActiveSheet.Protect Password:=Sheets("Indstillinger").Range("B9").Value
    Application.EnableEvents = True
End Sub

Tak for indput Beer

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: EXCELGAARD
Posteringsdato: 07.Jan.2019 kl. 15:53
Det er noget dobbelt, at benytte... 
Range(Target.Address).Select
Du kan blot benytte: 
Target.Select



-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: Ib Hansen
Posteringsdato: 07.Jan.2019 kl. 17:10
Du har ret Hug
Du skal skydes ved daggry LOL

Tak for hjælpen


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)


Print side | Luk vindue