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
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
Vastaukset 3
Vanhimmat
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
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