Eilisen päivämäärän metsästys jälleen!

M1nähän s3

Moro,

miten minä saan tätä koodia muutettua sillä tapaa että se antaa minulle EILISEN päivämäärän?? Koodi kyllä tekee sen pienen mutkan kautta mutta olisi ihan kiva mennä suorinta tietä.

Minulla on siis työkirjassa kaksi Commandbuttonia, toisessa on koodi joka antaa tämän hetkisen päivämäärän, ja toiseen nappiin haluaisin koodin joka antaa eilisen päivän. Nämä päivämäärät aukeavat siis uusina välilehtinä ja ovat nimetty päivämäärän mukaan. Kaek toimii niinku pittää mutta tämä eilisen päivän koodi toimii tällä tapaa;

Painan nappia, se antaa tämän päivän, painan uudestaan samasta napista, se antaa eilisen päivämäärän. Mikä kohta tässä koodissa pitää poistaa että se antaa VAIN eilisen päivämäärän?? Kiitokset etukäteen!

Sub Eilinen()
ActiveWorkbook.Unprotect
Worksheets("Default").Visible = True
Dim CurrentDay As Integer
Dim NewName As String
Dim WS As Worksheet
Set WS = ActiveSheet
If IsNumeric(Right(WS.Name, 2)) Then
CurrentDay = Right(WS.Name, 2)
ElseIf IsNumeric(Right(WS.Name, 1)) Then
CurrentDay = Right(WS.Name, 1)
Else
Exit Sub
End If
CurrentDay = CurrentDay 1
NewName = Day(Date) - 1 & "." & Month(Date) & "." & Year(Date)
'NewName = Format(Date, "dd.mm.yyyy")
Dim checkWs As Worksheet
On Error Resume Next
Set checkWs = Worksheets(NewName)
If checkWs Is Nothing Then
'Copies the current sheet to the end of the workbook
Sheets("Default").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewName
ActiveSheet.Unprotect
Range("D2") = NewName
ActiveSheet.Protect
Dim oleObj As OLEObject
Else
Set checkWs = Nothing
MsgBox "EILINEN PÄIVÄMÄÄRÄ ON LISÄTTY JO!"
End If
Worksheets("Default").Visible = False
ActiveWorkbook.Protect
End Sub

3

124

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Sub Eilinen()
      On Error Resume Next
      ActiveWorkbook.Unprotect
      If Worksheets(Format(Date - 1, "dd.mm.yyyy")) Is Nothing Then
      Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
      ActiveSheet.Name = Format(Date - 1, "dd.mm.yyyy")
      Else
      MsgBox "EILINEN PÄIVÄMÄÄRÄ ON LISÄTTY JO!"
      End If
      ActiveWorkbook.Protect
      End Sub

      Keep EXCELing
      @Kunde

    • Ja vieläkin sama m1e

      Kiitokset! Se toimii täydellisesti!!

      Voisitkos vielä sen verran opastaa että saako tuohon koodin liitettyä TOISSAPÄIVÄÄ??? Eli jos painan nappia, se avaa uuden välilehden ja antaa eilisen päivämäärän, napsautan toisen kerran, se avaa taas uuden välilehden ja antaa toissapäiväisen ???

      Jos ei ole mahdollista niin laitan kaksi nappia.

      • Option Explicit

        Sub Eilinen()
        Dim vastaus As String
        On Error Resume Next
        ActiveWorkbook.Unprotect
        vastaus = MsgBox("Eilinen (Kyllä) vaiko toissapäiväinen (Ei)?", vbQuestion vbYesNo, "Uuden taulukon lisäys")
        If vastaus = 6 Then
        If Worksheets(Format(Date - 1, "dd.mm.yyyy")) Is Nothing Then
        Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Format(Date - 1, "dd.mm.yyyy")
        Else
        MsgBox "EILINEN PÄIVÄMÄÄRÄ ON LISÄTTY JO!"
        End If
        Else
        If Worksheets(Format(Date - 2, "dd.mm.yyyy")) Is Nothing Then
        Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Format(Date - 2, "dd.mm.yyyy")
        Else
        MsgBox "TOISSAPÄIVÄN PÄIVÄMÄÄRÄ ON LISÄTTY JO!"
        End If
        End If

        ActiveWorkbook.Protect
        End Sub

        Keep EXCELing
        @Kunde


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Mihin kaivattusi

      Ja sinun juttusi kaatui?
      Ikävä
      78
      2892
    2. En löydä sinua

      En löydä sinua täältä, etkä sinä varmaankaan minua. Ennen kirjoitin selkeillä tunnisteilla, nyt jätän ne pois. Varmaan k
      Ikävä
      23
      2742
    3. Eelin, 20, itsemurhakirje - Suomalaisen terveydenhuollon virhe maksoi nuoren elämän

      Yksikin mielenterveysongelmien takia menetetty nuori on liikaa. Masennusta sairastava Eeli Syrjälä, 20, ehti asua ensi
      Maailman menoa
      107
      2342
    4. Opettelen sun jokaisen virheen

      ja rakastan sua.
      Ikävä
      35
      1668
    5. Hajoaako persut kuten 2017?

      https://www.is.fi/politiikka/art-2000011217813.html Tämä on totisinta totta. Persut on murroksessa. Osa jättää puolueen
      Maailman menoa
      240
      1568
    6. Mihin se sysipska hävisi?

      Katso Frida Kahlo elämäkerta ja opi.
      Ikävä
      32
      1537
    7. Kamala uutinen: Henkilö kuoli Tokmannin pihaan Kankaanpäässä- Jäi trukin alle

      IL 9.5.2025 Ihminen kuoli Kankaanpään Tokmannin edustalla perjantaina aamupäivästä. Poliisin mukaan henkilö oli jäänyt
      Kankaanpää
      40
      1495
    8. Mitä haluat oikeasti

      Mun ymmärtävän? Sitäkö ettet rakasta ja ole valmis mihinkään?
      Ikävä
      28
      1290
    9. Ne oli ne hymyt

      Mitä vaihdettiin. Siksi mulla on taas niin järjetön ikävä. Jos haluat musta eroon päästä niin älä huomioi mua. Muuten kä
      Ikävä
      20
      1256
    10. Mitä uskot sinun

      Ja kaivattusi välillä tulevan tapahtumaan lähiaikoina
      Ikävä
      95
      1181
    Aihe