Help: Probleem met bestaande VBA code EXCEL !

[dannydko]

VBA Code t.b.v. planning rooster

Betreft :

Ten behoeve onze planning sheet/rooster gebruiken wij de volgende vba code:
Wat doet deze code ?:

1) Deze code zorgt ervoor dat wanneer de sheet geopend wordt deze zal openen op de huidige week. (Hierdoor hoef je niet te scrollen naar de juiste week. + deze code opent altijd de volledige week)

2) Deze code verandert deze code ook de kleur van de eerste 3 rijden.
(in dit geval 7:7+:8:8+9:9) (zie : 'eerst de 3 rijen lichtgrijs maken)

Probleem : Deze code heeft 3 weken keurig gewerkt, maar nu ondervinden we de volgende problemen :

• Sheet opent niet meer op de juiste week (zie punt 1) (opent op de stand waarop deze sheet is gesaved)

• De eerste 3 rijen worden niet meer gekleurd. (zie punt 2)

Kunnen jullie ontdekken waarom deze code niet meer werkt?

Belangrijk om te weten :

• We draaien op een Netwerk

• De maandwisseling is nog niet doorgevoerd.

Gebruikte codes :

Private Sub Workbook_Open()

'ActiveWorkbook.SaveCopyAs "K:\Algemeen\Centrale Planning\backup\planning" & Format(Now(), "dd-m-yyyy") & ".xlsm"

Dim datumvandaag As String
Dim dagnummer
Dim rij As Range
Dim onzecel As Range
Dim onzeweek As Range
datumvandaag = Format(Now(), "dd-m-yyyy")
dagnummer = Format(Now(), "w") '"w" geeft dag van de week (zondag =1, zaterdag =7)

'eerst de 3 rijen lichtgrijs maken
Set rij = ActiveSheet.Range("9:9") 'rij 9 selecteren
ActiveSheet.Range("7:7").Interior.Color = RGB(242, 242, 242)
ActiveSheet.Range("8:8").Interior.Color = RGB(242, 242, 242)
ActiveSheet.Range("9:9").Interior.Color = RGB(242, 242, 242)


For Each cel In rij
If cel.Value = datumvandaag Then
'verplaatsen naar deze week
Set onzecel = ActiveSheet.Cells(cel.Row, cel.Column - (dagnummer - 2)) 'correctie om eerste dag van de week te kiezen ook als het al vrijdag is
Application.GoTo onzecel, True
'active week donker kleuren
Set onzeweek = ActiveSheet.Range(ActiveSheet.Cells(cel.Row - 2, cel.Column - (dagnummer - 2)), ActiveSheet.Cells(cel.Row, cel.Column - (dagnummer - 2) + 6))
onzeweek.Interior.ColorIndex = 15
End If

 

[Cobbe]

2 kleine aanpassingen doorgevoerd (rood):

Private Sub Workbook_Open()

 'ActiveWorkbook.SaveCopyAs "K:\Algemeen\Centrale Planning\backup\planning" & Format(Now(), "dd-m-yyyy") & ".xlsm"

 Dim datumvandaag As String
 Dim dagnummer
 Dim rij As Range
 Dim onzecel As Range
 Dim onzeweek As Range
 datumvandaag = Format(Now(), "dd-m-yyyy")
 [COLOR="#FF0000"][B]dagnummer = DatePart("w", Date, 1, 2) '"w" geeft dag van de week (zondag =1, zaterdag =7)[/B][/COLOR]

 'eerst de 3 rijen lichtgrijs maken
 With ActiveSheet
 Set rij = .Range("9:9") 'rij 9 selecteren
    .Rows("7:9").Interior.Color = RGB(242, 242, 242)
 
 For Each cel In rij
 If [B][/B][COLOR="#FF0000"]Format(cel, "dd-m-yyyy")[/COLOR] = datumvandaag Then
 'verplaatsen naar deze week
 Set onzecel = .Cells(cel.Row, cel.Column - (dagnummer - 2)) 'correctie om eerste dag van de week te kiezen ook als het al vrijdag is
 Application.GoTo onzecel, True
 'active week donker kleuren
 Set onzeweek = .Range(ActiveSheet.Cells(cel.Row - 2, cel.Column - (dagnummer - 2)), ActiveSheet.Cells(cel.Row, cel.Column - (dagnummer - 2) + 6))
 onzeweek.Interior.ColorIndex = 15
 End If
Next
End With
End Sub

 

[snb]

1 wie heeftr deze code gemaakt dan ?

2. zet VBA code svp tussen code tags !

3. ooit gehoord van

 Rows("7:9").interior.colorindex=15

4. waarom zoek je 'vandaag' niet met cells.find ?

 

[dannydko]

Deze aanpassing lijkt gewerkt te hebben!

het werkt weer volledig!

ontzettend bedankt voor jullie snelle reacties!

Groeten

Danny

2 kleine aanpassingen doorgevoerd (rood):

Private Sub Workbook_Open()

 'ActiveWorkbook.SaveCopyAs "K:\Algemeen\Centrale Planning\backup\planning" & Format(Now(), "dd-m-yyyy") & ".xlsm"

 Dim datumvandaag As String
 Dim dagnummer
 Dim rij As Range
 Dim onzecel As Range
 Dim onzeweek As Range
 datumvandaag = Format(Now(), "dd-m-yyyy")
 dagnummer = Format(Now(), "w") [B][/B][COLOR="#FF0000"]* 1[/COLOR] '"w" geeft dag van de week (zondag =1, zaterdag =7)

 'eerst de 3 rijen lichtgrijs maken
 With ActiveSheet
 Set rij = .Range("9:9") 'rij 9 selecteren
    .Rows("7:9").Interior.Color = RGB(242, 242, 242)
 
 For Each cel In rij
 If [B][/B][COLOR="#FF0000"]Format(cel, "dd-m-yyyy")[/COLOR] = datumvandaag Then
 'verplaatsen naar deze week
 Set onzecel = .Cells(cel.Row, cel.Column - (dagnummer - 2)) 'correctie om eerste dag van de week te kiezen ook als het al vrijdag is
 Application.GoTo onzecel, True
 'active week donker kleuren
 Set onzeweek = .Range(ActiveSheet.Cells(cel.Row - 2, cel.Column - (dagnummer - 2)), ActiveSheet.Cells(cel.Row, cel.Column - (dagnummer - 2) + 6))
 onzeweek.Interior.ColorIndex = 15
 End If
Next
End With
End Sub

 

[snb]

@Cobbe,

Kijk dan ook nog even naar DatePart("ww", Date, 2, 2)

 

[Cobbe]

@snb
Aangepast!!

 

[snb]

@Cobbe

Ik dacht dat het over het weeknummer ging, dan is

Datepart("ww",date,2,2)

maar voor de dag van de week gebruik je gewoon

Weekday(date,2)

 

[Cobbe]

Ik, ik denk dat jij te veel denkt.

 

[snb]

Dat denk ik niet...