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


Emne lukketEn lille "ting" i en klokkeslætskode

 Besvar Besvar
Forfatter
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: En lille "ting" i en klokkeslætskode
    Sendt: 14.Jan.2018 kl. 14:47
På et tidspunkt fik jeg lavet en meget værdifuld koder, der konverterer et tal til et klokkeslæt, når tallet tastes i en celle.
Men hvis man taster en separator i tallet, kommer der en advarsel, at separator ikke må bruges.
Koden sørger selv for at sætte separatoren i klokkeslættet.

Jeg har brugt koden uanede gange i forskellige ark og den er fantastisk Big smile
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'-----------------------------------------'
' Ændre almindeligt tal til et klokkeslæt '
'-----------------------------------------'
     Dim TimeStr As String
     On Error GoTo EndMacro
'----------------------------------------------------------------------------'
' Vælg område - Flere områder kan vælges - Brug Range("A1:B10, D1:E10") osv. '
'----------------------------------------------------------------------------'
    If Intersect(Target, Sheets("Forside").Range("J2:N200, R2:S200")) 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
'------------'
' Hvis Error '
'------------'
EndMacro:
    ActiveCell.Offset(-1, 0).Select: Selection = ""
'-------------------------'
' Msgbox - 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"
'-----------------'
' MsgBox settings '
'-----------------'
    YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox _
    , vbOKOnly + vbInformation, "Ugyldig indtastning")
'--------------------------------'
' Lås ark op - Konverter til tid '
'--------------------------------'
    ActiveSheet.Unprotect Password:=Sheets("Indstil").Range("B1").Value
    ActiveCell.NumberFormat = "hh:mm"
'---------'
' Lås ark '
'---------'
    ActiveSheet.Protect Password:=Sheets("Indstil").Range("B1").Value
    Application.EnableEvents = True

Den har dog en lille "ting", jeg har prøvet at rette, men ikke rigtigt formår Pig Øf Øf Øf
- I starten af koden, går den til "EndMacro" On Error, hvis der f.eks. tastes en separator.
- Og "EndMacro" får den til at hoppe "Offset" en celle op og slette den.
- Det er markeret med rødt i koden.

Det er fint, hvis man bruger "Enter" når tallet med separator er tastet.
"Enter" hopper en celle ned og "EndMacro" hopper tilbage og sletter fejlen.

Men hvad hvis man f.eks. bruger piltasten til højre, for at hoppe til næste celle i rækken ?
Så virker "EndMacro" ikke og man risikerer at den hopper og sletter et forkert klokkeslæt.

Jeg har prøvet en masse, f.eks. en "Where Am I".
Den virker bare ikke og den vil også "huske" den forkerte celle, når "Enter" eller en piltast er brugt.

Koden skal nok indsættes før "On Error GoTo", men hvordan ?
EndMacro:
    'ActiveCell.Offset(-1, 0).Select: Selection = ""
'------------'
' Where Am I '
'------------'
    Dim WAI As String
    WAI = ActiveCell.Name = ""

En anden "ting", men måske ikke så vigtigt.
Jeg bruger ofte Ctrl+Z (fortryd), hvis jeg f.eks. har slettet et klokkeslæt, der skulle beholdes.
Men klokkeslæt, der fortrydes, indeholder jo en separator, der ulovligt i koden.
Når klokkeslættet er indsat med genvejen, hopper den en celle op og sletter den.

Er det muligt at Deaktivere hele klokkeslætskoden, hvis Ctrl+Z bruges ?

F.eks i starten af koden.
If Application.OnKey "koden for Ctrl+Z her" Then Exit Sub

Pyh ha en lang tekst, men jeg lider af "et eller andet", der gør, jeg godt vil forklare mig så godt som muligt.
Og det er endnu engang bekræftet her Geek

Mange vil nok falde i søvn, før de når hertil Disapprove
Men jeg håber at kunne få hjælp af de ihærdige, der ikke lider af læsekrampe Tongue

På forhånd tak Wink

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
excelent Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 12.Apr.2011
Land: DK
Status: Offline
Point: 2171
Accepteret svar Accepteret svar
Direkte link til dette indlæg Sendt: 14.Jan.2018 kl. 16:25
retur til samme celle :
Range(Target.Address).Select
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
Til top
EXCELGAARD Se dropdown
Platin bruger
Platin bruger


Medlem: 27.Dec.2012
Land: Denmark
Status: Offline
Point: 5412
Direkte link til dette indlæg Sendt: 14.Jan.2018 kl. 15:37
Jeg har ikke lige tid til, at indtaste hele din makro, men kan du ikke bare udskifte din røde linje med:

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
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: 14.Jan.2018 kl. 15:42
Jeg prøver Wink

Men du kan altid kopiere koden fra forum Ctrl+C og indsætte den i et ark Ctrl+V.
Det sparer en masse skrive arbejde.

Har du OnKey koden for Ctrl+Z ?

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
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: 14.Jan.2018 kl. 15:45
Target:Value = "" - Hopper en celle ned og sletter den i stedet, når man bruger "Enter".
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
excelent Se dropdown
Guld bruger
Guld bruger
Avatar

Medlem: 12.Apr.2011
Land: DK
Status: Offline
Point: 2171
Accepteret svar Accepteret svar
Direkte link til dette indlæg Sendt: 14.Jan.2018 kl. 16:25
retur til samme celle :
Range(Target.Address).Select
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
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: 16.Jan.2018 kl. 11:27
Hvorfor fik jeg ikke besked om Excelents forslag i min mailboks - Hmmm Angry

Koden virker Thumbs Up

Og med denne kode, bliver den stående og sletter samtidigt det indtastede.
Range(Target.Address).Select: Selection = ""

Tusind tak for hjælpen Beer

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
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

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