Dansk Regneark Forum
  Hjælp Hjælp  Søg i forum   Arrangementer   Opret ny bruger Opret ny bruger  Log ind Log ind


Emne lukketKode - Husk position
 Besvar Besvar
Forfatter
  Emne Søg Emne Søg  Emne funktioner Emne funktioner
Ib Hansen Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652 		Direkte link til dette indlæg Emne: Kode - Husk position
    Sendt: 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)
Til top



Til top
EXCELGAARD Se dropdown
Platin bruger
Platin bruger


Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5470 		Accepteret svar Accepteret svar
Direkte link til dette indlæg Sendt: 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.
Til top
EXCELGAARD Se dropdown
Platin bruger
Platin bruger


Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5470 		Direkte link til dette indlæg Sendt: 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.
Til top
EXCELGAARD Se dropdown
Platin bruger
Platin bruger


Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5470 		Direkte link til dette indlæg Sendt: 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.
Til top
Ib Hansen Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652 		Direkte link til dette indlæg Sendt: 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

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)
Til top
EXCELGAARD Se dropdown
Platin bruger
Platin bruger


Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5470 		Accepteret svar Accepteret svar
Direkte link til dette indlæg Sendt: 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.
Til top
Ib Hansen Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652 		Direkte link til dette indlæg Sendt: 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)
Til top
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

© 2010 - 2024 Dansk Regneark Forum - en del af Excel-regneark.dk