macro limiteren tot 1x per jaar

[ewaldmauritz]

Ik heb onderstaande macro opgenomen:

Sub Deadlines_updaten()
'
' Deadlines_updaten Macro
'

'
    If MsgBox("Weet u zeker dat u de deadlines wilt updaten? De deadlines van het afgelopen jaar worden hiermee verwijderd. Sla eventueel een backup van dit bestand op om de deadlines van vorig jaar te bewaren!!", vbOKCancel) = vbCancel Then Exit Sub
    Range("BJ8:FI57").Select
    Selection.Copy
    Range("J8").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("DJ8:FI57").Select
    Selection.ClearContents
    Range("J8").Select
End Sub

Kan iemand voor mij een stuk vba toevoegen zodat deze macro maar maximaal 1x per jaar gedraaid kan worden? Als dit voor de 2e keer in hetzelfde jaar wordt gedaan, zou er een foutmelding moeten komen.

 

[popipipo]

Een macro is een programmaatje dat een bepaald aantal handelingen verricht die regelmatig gedaan moeten worden.
Of dat het een ingewikkelde en lange handeling is.
Als iets 1 maal per jaar gedaan moet worden vind ik dat dit niet in overeenstemming is met wat hierboven staat.
Je hier getoonde macro is ook niet zo ingewikkeld en lang.

Dus waarom niet zelf handmatig deze handeling 1 maal per jaar doen?

 

[wildboy]

Zit aan het volgende te denken
Als de macro wordt gestart controleert hij of een een bepaalde cel een jaartal staat bv 2012 komt dit overeen met het huidige jaar dan is de macro dit jaar al gedraaid en krijg je een melding
is dit niet het geval dan plaatst hij het huidige jaartal in de cel , en werkt vervolgens de rest van je macro af.


is dat iets? .....

 

[HSV]

Zet in cel A1 eens 2011, zet de code in Thisworkbook en sla het op.
Heropen het bestand.

Private Sub Workbook_Open()
' Deadlines_updaten Macro
 If MsgBox("Weet u zeker dat u de deadlines wilt updaten? De deadlines van het afgelopen jaar worden hiermee verwijderd. Sla eventueel een backup van dit bestand op om de deadlines van vorig jaar te bewaren!!", vbOKCancel) = vbCancel Then Exit Sub
    If Year(Range("A1")) < Year(Now()) Then
    With Sheets(1)
     .Range("J8:DI57") = .Range("BJ8:FI57").Value
     .Range("DJ8:FI57").ClearContents
  End With
  End If
End Sub

 

[ewaldmauritz]

@ popipio: in dit geval is de macro bedoeld om gebruikers een voor hen ingewikkelde handeling met een klik op de knop uit te kunnen laten voeren. Om het ongewenst wissen van gegevens te voorkomen, mag dit maar ens per jaar gedaan worden.

@ wildboy: Lijkt me een interessante oplossing. Heb je toevallig een vba-code voor mij. Ben namelijk niet handig met VBA.

@ HSV: als ik jouw code invoer, wordt de vraag al gesteld als het bestand wordt geopend. Ik zou graag willen dat er pas een melding komt als de knop om de deadlines te updaten aangeklikt wordt. Bv: U heeft de deadlines dit jaar al geupdate.

 

[HSV]

Iets gehusseld: Ongetest.

Private Sub Workbook_Open()
' Deadlines_updaten Macro
     If Range("A1") < Year(Now()) Then
If MsgBox("Weet u zeker dat u de deadlines wilt updaten? De deadlines van het afgelopen jaar worden hiermee verwijderd. Sla eventueel een backup van dit bestand op om de deadlines van vorig jaar te bewaren!!", vbOKCancel) = vbCancel Then Exit Sub
    With Sheets(1)
     .Range("J8:DI57") = .Range("BJ8:FI57").Value
     .Range("DJ8:FI57").ClearContents
  End With
  End If
End Sub

 

[snb]

Ik zou gebruikers hiermee dan ook helemaal niet willen lastigvallen:

private Workbook_open()
   if year(ThisWorkbook.BuiltinDocumentProperties(12))<year(date) then Sheets(1).Range("J8:DI57") = sheets(1).Range("BJ8:FI57").Value
end sub

 

[ewaldmauritz]

@ HSV
Ik heb het erin gezet en volgens mij werkt het. Alleen wordt er in cel A1 na het updaten niet 2012 gezet. Dit moet wel anders wordt de macro iedere keer dat je het programma opstart gedraaid.
En ik zou het graag zien bij alle sheets met een naam. Nu staat er sheet (1), maar dat moet worden: sheet ("Adrian", "......." , etc. , "Rutger"). Ik heb dat al geprobeerd, maar krijg een foutmelding. Blijkbaar moet je dat in VBA anders noteren. Maar jij weet ongetwijfeld hoe.

 

[HSV]

Als je geen gebruik wil maken van @snb z'n code, gaan we verder.
Test het eens.

Private Sub Workbook_Open()
Dim sh As Worksheet
' Deadlines_updaten Macro
     If Range("A1") < Year(date) Then
If MsgBox("Weet u zeker dat u de deadlines wilt updaten? De deadlines van het afgelopen jaar worden hiermee verwijderd. Sla eventueel een backup van dit bestand op om de deadlines van vorig jaar te bewaren!!", vbOKCancel) = vbCancel Then Exit Sub
    For Each sh In Sheets
    With sh
      .Range("J8:DI57") = .Range("BJ8:FI57").Value
      .Range("DJ8:FI57").ClearContents
      .Range("A1") = Year(Date)
        End With
      Next sh
   End If
End Sub

 

[ewaldmauritz]

Ik heb het getest en het werkt bijna zoals ik zou willen. Omdat er door een ander al gebruikte vba code Workbook_open al een gedefinieerde naam was voor worksheet (namelijk ws) heb ik sh veranderd in ws. Maar dat is een praktische wijziging.
Ik loop tegen 2 dingen aan:
1. Als de bladen beveiligd zijn dan kan de macro niet gedraaid worden. Hij geeft een foutmelding. Dit zou niet moeten.
2. De macro draait nu op alle bladen. Maar er zijn een aantal bladen waar de macro niet op gedraaid moet worden, namelijk: Totaaloverzicht, TTH, TV en TJ. Dit had ik in mijn vorige post niet echt duidelijk verwoord zie ik.

Is het mogelijk iets in te bouwen dat deze 2 problemen niet meer voorkomen?
Stapje voor stapje komen we er wel. Super dat je wilt helpen hiermee.

 

[HSV]

Zoiets voor beide meldingen.

Private Sub Workbook_Open()
Dim sh As Worksheet
' Deadlines_updaten Macro
     If Sheets(1).Range("A1") < Year(Now()) Then
If MsgBox("Weet u zeker dat u de deadlines wilt updaten? De deadlines van het afgelopen jaar worden hiermee verwijderd. Sla eventueel een backup van dit bestand op om de deadlines van vorig jaar te bewaren!!", vbOKCancel) = vbCancel Then Exit Sub
    For Each sh In Sheets
    If WorksheetFunction.And(sh.Name <> "Totaaloverzicht", sh.Name <> "TTH", sh.Name <> "TV", sh.Name <> "TJ") Then
    With sh
     .Unprotect
     .Range("J8:DI57") = .Range("BJ8:FI57").Value
     .Range("DJ8:FI57").ClearContents
     .Range("A1") = Year(Date)
     .Protect
       End With
     End If
    Next sh
  End If
End Sub

 

[ewaldmauritz]

Fantastisch. Het werkt als een trein. Heb zelf nog een kleine toevoeging gedaan en dat werkt ook. Ik ben dus helemaal blij.
Enorm bedankt voor je hulp. En de rest natuurlijk ook voor het meedenken.