Excel 2003 - hjelp med makroprogrammering

[Solaar]

Jeg ønsker å lage en makro som kopierer et ark i like stort antall som den til enhver tid inneværende måned, OG omdøper hvert ark med riktig dato og ukedag,

 

Jeg har googlet og funnet en makro som, når jeg kjører den, popper opp en boks der jeg må fylle ut månedsnr og så oppretter den alle dagene slik jeg ønsker. Men jeg vet ikke hvordan jeg skal få den til å kopiere et eksisterende ark i stedet for å opprette nye. Noen som kan hjelpe meg med dette?

 

 

[Harald Staff]

Antakelig, men jeg forstår ikke helt hva du spør om. Men se om denne får deg i gang, kjør den mens du står i et ark ved navn Ark1.

 

Sub Demo()
Dim Dt As Date
Dim Wks As Worksheet
Dim Wb As Workbook
ThisWorkbook.Sheets("Ark1").Copy
DoEvents
Set Wks = ActiveSheet
Set Wb = Wks.Parent
Wks.Name = Format(DateSerial(Year(Date), Month(Date), 1), "dddd dd.mm.yy")
For Dt = DateSerial(Year(Date), Month(Date), 2) To DateSerial(Year(Date), Month(Date) + 1, 0)
   Wks.Copy After:=Sheets(Wb.Sheets.Count)

   Wb.Sheets(Wb.Sheets.Count).Name = Format(Dt, "dddd dd.mm.yy")

Next
End Sub

 

HTH. Beste hilsen Harald

[Solaar]

Hehe, skjønner godt at du ikke helt forsto hva jeg spurte om siden jeg glemte å linke til den opprinnelige makroen jeg hadde brukt. Men allikevel klarte du å gi meg akkurat det jeg var ute etter, tusen takk! Et spørsmål har jeg bare: Vil datoene som genereres automatisk tilsvare inneværende måned, altså vil den lage en excelbok med datoene i februar dersom det hadde vært den 1. februar i dag?

 

En liten ting til også: Hvis jeg, etter at den nye boken er opprettet, ønsker at den skal beskyttes (uten passord), hva må skrives på enden da? Kunne du gitt meg den linjen også så jeg får lagt til den på slutten? (regner med at det legges rett før "next"?)

[Harald Staff]

Den lager inneværende måned, så det blir februar i februar, og 29 dager i februar 2016.

 

Beskyttelse er så mangt. Beskytte strukturen i arbeidsboken mot nye ark og arknavn:

 

Next
'NY LINJE TIL SLUTT:
Wb.Protect Structure:=True, Windows:=False
End Sub

 

Beste hilsen Harald

[Solaar]

Jeg ønsker å beskytte regnearket og alt innhold i de låste cellene. Dvs som om jeg hadde valgt fra menylinjen: verktøy -> beskyttelse -> beskytt ark (og deretter bare trykt enter på standardvalget som dukker opp, uten å legge inn passord).

[Harald Staff]

Det er noe helt annet enn å beskytte boken -som jeg foreslår du beholder slik jeg skrev over, så ingen ødelegger datostrukturen.

 

Set Wb = Wks.Parent
'NY LINJE HER:
Wks.Protect

[Solaar]

Ok. Tusen takk igjen, det fungerte. Så en siste ting, håper du kan hjelpe meg med det også. Vil at makroen til slutt skal gjøre slik at man hopper til det første arket og velger celle A4, hvordan får jeg det inn i den samme koden?

 

Har forsøkt:

 

JumpFirst()
Sheets(1).Activate
Range("A4").Select

 

...men får det ikke til å fungere?

[Harald Staff]

Du legger det der du vil det skal skje, som bør være til slutt. Her, samlepakke av hva vi har snakket om:

 

Sub Demo()
Dim Dt As Date
Dim Wks As Worksheet
Dim Wb As Workbook
ThisWorkbook.Sheets("Ark1").Copy
DoEvents
Set Wks = ActiveSheet
Set Wb = Wks.Parent
Wks.Protect
Wks.Name = Format(DateSerial(Year(Date), Month(Date), 1), "dddd dd.mm.yy")
For Dt = DateSerial(Year(Date), Month(Date), 2) To DateSerial(Year(Date), Month(Date) + 1, 0)
   Wks.Copy After:=Sheets(Wb.Sheets.Count)

   Wb.Sheets(Wb.Sheets.Count).Name = Format(Dt, "dddd dd.mm.yy")
Next
Wb.Protect Structure:=True, Windows:=False
Sheets(1).Activate
DoEvents
Range("A4").Select
End Sub

 

ellers kan du legge den som en separat prosedyre eller funksjon og kalle den fra hovedprosedyren, men skriftlig opplæring i slikt er litt utenfor rammene av et forum som dette.

 

Beste hilsen Harald

[Solaar]

Ok, så den siste koden her tar med alt det vi har snakket om? Får ikke testet det igjen før på tirsdag så gir deg en tilbakemelding da. Uansett skal du ha tusen takk for at du tok deg tid til å hjelpe meg med dette, det setter jeg stor pris på!

[Solaar]

Suverent, det ble akkurat slik jeg ønsket. Igjen: Tusen takk!