• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Venster scrollen met VBA

Status
Niet open voor verdere reacties.
Wat heeft deze regel voor zin.
Code: 
ActiveWindow.ScrollRow = 1
Of de hele code.....
 
@Harry,
Ik constateer dat als ik in het model #29 de begindatum (cel O1) aanpas naar bv 30-01-2017 de macro een foutmelding geeft (400) die ik niet weet op te lossen.
FS-2017-02-01_123629.jpg
 
Plaats het bestand eens met de wijzigingen die je gedaan hebt in het blad en aan de code.
 
HSV zei:
Plaats het bestand eens met de wijzigingen die je gedaan hebt in het blad en aan de code.
Klik om te vergroten...

Code: 
Sub Workbook_Open()

Dim lLaatsteRij As Long
Dim wk As Long

wk = DatePart("ww", Date, vbMonday, vbFirstFourDays)
With Sheets("Planning")
  ' .Columns(4).AutoFit
    Columns("D:E").ColumnWidth = 8.12
    If wk = 1 Then
       Application.Goto .Range("F7"), True
    Else
       Application.Goto .Rows(3).Find(wk, , xlValues, xlWhole).Offset(3, -7), True
    End If
    
    lLaatsteRij = Range("A7").End(xlDown).Row
 Set c = .Range("D7:D" & lLaatsteRij + 1).Find(CDate(Application.Min(.Range("D7:D" & lLaatsteRij + 1))))
   If Not c Is Nothing Then
     Application.Goto c
   Else
     Application.Goto .Range("B7")
  End If
 End With
End Sub
 

Bijlagen

Laatst bewerkt:
De blauwe is aangepast.
Code: 
Columns("D:E").ColumnWidth = 8.12
[COLOR=#0000ff]    If .Range("F3") = wk Then[/COLOR]
       Application.Goto .Range("F7"), True
 
Harry, ik heb je hulp nog een keer nodig.
Als de jongste zoekdatum lager vermeld staat dan activiteit 18 dan gaat het R venster naar de 1e week van de planning en niet meer nar de actuele week.
Zodra er een paar rijen boven activiteit verborgen worden wordt door de macro (door de ster-figuur te activeren) weer de actuele week getoond.
Zie bijlage en code.
Code: 
Sub Auto_Open()
Dim wk As Long, c As Range
wk = DatePart("ww", Date, vbMonday, vbFirstFourDays)
With Sheets("Planning")
 .Columns(4).AutoFit
    If wk = 1 Then
       Application.Goto .Range("F7"), True
    Else
       Application.Goto .Rows(3).Find(wk, , xlValues, xlWhole).Offset(4, -7), True
    End If
 Set c = .Range("D7:D18").Find(CDate(Application.Min(.Range("D7:D18"))))
   If Not c Is Nothing Then
     Application.Goto c
   Else
     Application.Goto .Range("B7")
  End If
 End With
End Sub

Code aangepast - was niet compleet
 

Bijlagen

Laatst bewerkt:
snb zei:
!!!
Klik om te vergroten...

Misschien bedoel je dat ik de vraag direct aan Harry gesteld heb? Dit heb ik gedaan met de gedachte dat hij de bron is van de oplossing. Dat wil niet zeggen dat ik anderen wilde passeren. Als dat wel zo overgekomen is, dan mijn welgemeende excuses.
 
Helaas begrijp ik niet veel van je verhaal Anton.

Onderstaand stukje heb ik vast niet geschreven.
Code: 
lLaatsteRij = Range("A7").End(xlDown).Row
 Set c = .Range("D7:D" & lLaatsteRij + 1).Find(CDate(Application.Min(.Range("D7:D" & lLaatsteRij + 1))))
   If Not c Is Nothing Then
     Application.Goto c
 
HSV zei:
Helaas begrijp ik niet veel van je verhaal Anton.

Onderstaand stukje heb ik vast niet geschreven.
Code: 
lLaatsteRij = Range("A7").End(xlDown).Row
 Set c = .Range("D7:D" & lLaatsteRij + 1).Find(CDate(Application.Min(.Range("D7:D" & lLaatsteRij + 1))))
   If Not c Is Nothing Then
     Application.Goto c
Klik om te vergroten...

Harry,
In #24 staat de code
Code: 
Sub Auto_Open()
Dim wk As Long, c As Range
wk = DatePart("ww", Date, vbMonday, vbFirstFourDays)
With Sheets("Planning")
 .Columns(4).AutoFit
    If wk = 1 Then
       Application.Goto .Range("F7"), True
    Else
       Application.Goto .Rows(3).Find(wk, , xlValues, xlWhole).Offset(4, -7), True
    End If
 Set c = .Range("D7:D18").Find(CDate(Application.Min(.Range("D7:D18"))))
   If Not c Is Nothing Then
     Application.Goto c
   Else
     Application.Goto .Range("B7")
  End If
 End With
End Sub

Hierin is later nog vervangen :
Code: 
 If wk = 1 Then  in     If .Range("F3") = wk Then om het begin van de kalender flexibel te maken
en
Set c = .Range("D7:D18") enz  in Set c = .Range("D7:D" & lLaatsteRij + 1) enz   Hierin bepaald lLaatsteRij de laatste rij in de kalender

Zoals aangegeven werkt dat allemaal zolang het aantal zichtbare rijen beperkt blijft.
 
Laatst bewerkt:
Om weer een beetje in het verhaal te komen.
Welke cel zou volgens jou geselecteerd moeten worden?
 
Lijkt goed te werken dan.
Als ik op de ster druk gaat het naar 20-03-2017 cel D25, dat is de jongste datum in kolom D.
 
HSV zei:
Lijkt goed te werken dan.
Als ik op de ster druk gaat het naar 20-03-2017 cel D25, dat is de jongste datum in kolom D.
Klik om te vergroten...

En welke kolom zie je dan als begin van de kalender ? Kolom F ? Maar dat is fout.
Verberg eens een paar rijen bv rij 10 t/m 15 dan zul je zien dat de kalender een gebied laat zien met de huidige datum.
 
Je scrolvenster staat op kolom AO.
 
HSV zei:
Je scrolvenster staat op kolom AO.
Klik om te vergroten...

en met alle rijen zichtbaar of een aantal verborgen ?
Bij mij bij alle rijen zichtbaar staat het scrolvenster op F als een jongste datum in kolom D staat in een gele rij.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan