• 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.
Ik heb het met diverse data getest door een P te plaatsen, en elke keer met een iets jongere datum.
De juiste cel is bij het heropenen van het bestand geselecteerd.
Waarom het bij jou niet werkt is me een raadsel.

Het enige wat ik nog kan doen is kolom D op een goede breedte zetten zodat een datum gevonden kan worden door de 'Find' methode.

Code: 
Private Sub Workbook_Open()
Dim wk As Long
wk = DatePart("ww", Date, vbMonday, vbFirstFourDays)
With Sheets("Planning")
[COLOR=#0000ff] .Columns(4).AutoFit[/COLOR]
    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

Meer kan ik er op het ogenblik niet van maken.
'Private' was verdwenen, maar daar heeft de code geen hinder van.
 
Laatst bewerkt:
Harry, bedankt voor je inspanningen.
Ik heb een maagdelijke versie voorzien van je code (zonder privat vanwege run-mogelijkheid bij geopend bestand). De zoekfunctie naar kleinste datum werkt ook niet evenals de code geplaatst in het eigenlijke workboek.
Het enige die werkt is de door jou geretourneerde versie scroll_02.xlsb. Ook na opslaan als .xlsm
Je lijkt dat ding betoverd te hebben maar ben er nog niet achter met wat :)

Ter verificatie mijn maagdelijke versie met jouw code. Werkt die wel bij jou ?
 

Bijlagen

Laatst bewerkt:
Nee, helaas werkt deze niet Ton.

Kolom D is niet breed genoeg om de datum van 17-01-2017 te kunnen zien.
Dan pas werkt het.
 
anton44 zei:
Harry,
(zonder privat vanwege run-mogelijkheid bij geopend bestand).
Klik om te vergroten...

Gebruik dan onderstaande code en plaats het in een standaard-module, en verwijder de code uit Thisworkbook.
Deze runt ook automatisch en in je overzicht staat er netjes 'Auto_open'.

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

Ook wordt kolom D op minimale breedte gezet.
 
Inderdaad, met een bredere kolom werkt het. Dat is de betovering.
De code .Columns(4).AutoFit zorgt niet voor voldoende breedte.
Hier zal een bepaalde breedte ingesteld moeten worden. Dan is wat mij betreft alles opgelost.
Voor mij werkt goed (mede afhankelijke van karaktergrootte)

Code: 
   Columns("D:D").ColumnWidth = 8.63
 
Ton,

.Columns(4).autofit zal doorgaans goed werken.
Het werkt hier iig goed, maar kan door de samenvoeging van kolom D en E in de cellen boven rij 7 wel voor roet in het eten gooien in jouw versie.

Ps. Ik schreef in #17 al dat de breedte van kolom D niet breed genoeg was.
Je ziet dat aan ###### in de cellen.

Veel succes ermee.
 
HSV zei:
Ton,

.Columns(4).autofit zal doorgaans goed werken.
Het werkt hier iig goed, maar kan door de samenvoeging van kolom D en E in de cellen boven rij 7 wel voor roet in het eten gooien in jouw versie.

Ps. Ik schreef in #17 al dat de breedte van kolom D niet breed genoeg was.
Je ziet dat aan ###### in de cellen.

Veel succes ermee.
Klik om te vergroten...

Harry, op mijn scherm was de datum altijd normaal leesbaar anders had ik de breedte al eerder aangepast.
Met .autofit wordt de breedte 12.63 (samenvoegcellen uitgeschakeld) terwijl 8.00 voldoende breed is (7.50 voldoet al voor de zoekfunctie)

Nogmaals dank :thumb: :thumb:
 
Graag gedaan.
 
Voor de belangstellenden hierbij het volledige model met een paar kleine aanpassingen, t.w.
1. Universeel selectiebereik - laatste regel - waarmee te lijst van activiteiten verder uitgebreid of ingekort kan worden zonder aanpassingen van de macro.
2. Keuzemogelijkheid voor vast in te stellen kolombreedte voor de datumkolom of .autofit (in VBA de bewuste regel dé- en activeren.
3. Voorwaardelijke opmaak in Plandatum kolom indien plandatum ouder is dan vandaag() - achterstand in activiteit.

Succes.
 

Bijlagen

@Harrie,
Ik heb de smaak te pakken en wil deze routine op een paar andere workbooks toepassen. Met dit verschil dat ik in een kolom naar de jongste datum wil gaan +1 cel naar beneden.
Pogingen om m.b.v. de codes in #19 dit te bewerkstelligen lopen op niets uit. De beveiliging voor de kalenderweken en 1e maandag e.d. zijn niet nodig.
 

Bijlagen

Zoiets?
Code: 
Sub Workbook_Open()
Dim ga_naar
With Sheets("Planning")
  .Columns(4).AutoFit
 ga_naar = Application.Match(Application.Min(.Columns(4)), .Columns(4), 0)
    Application.Goto .Cells(ga_naar, 4).Offset(1), True
 End With
End Sub
 
Komt al aardig in e buurt.
Het zoeken naar een MIN heb ik aangepast naar MAX.
De geselecteerde cel komt in de uiterste linker bovenhoek te staan, maw alle linker kolommen en bovenliggende rijen zijn niet zichtbaar - m.a.w. zou nog omhoog(?) moeten scrollen en naar R.
 
Verwijder het rode gedeelte.
Code: 
 Application.Goto .Cells(ga_naar, 4).Offset(1)[COLOR=#ff0000], True[/COLOR]
 
Werkt prima mits Titels blokkeren is ingeschakeld. Indien geen Titels blokkeren dan scrolled het beeld niet en komt de geselecteerde cel links boven in de hoek..
Hoe als gescrolled zou moeten worden.
 
Laatst bewerkt:
Scrollen zonder titelblokkering.
Code: 
Sub Workbook_Open()
Dim ga_naar
With Sheets("Planning")
  .Columns(4).AutoFit
 ga_naar = Application.Match(Application.Max(.Columns(4)), .Columns(4), 0)
    activewindow.scrollrow= .Cells(ga_naar, 4).Offset(1).Row
 End With
End Sub
 
Indien geen Geblokkeerde titels:
Met wat aanpassingen van mijn kant ;) komt de tabel in beeld door de code te runnen.
De waarden voor de scroll zijn erg toepassingsafhankelijk.

Code: 
Sub Workbook_Open()
Dim ga_naar
With Sheets("Planning")
  .Columns(4).AutoFit
 ga_naar = Application.Match(Application.Max(.Columns(4)), .Columns(4), 0)
 
    ActiveWindow.ScrollRow = .Cells(ga_naar, 4).Offset(-10).Row
    
 End With

    ActiveWindow.SmallScroll ToLeft:=20

End Sub

Aanvulling: met runnen vanaf een ander blad wordt het blad "Planning" niet meer geactiveerd
 
Laatst bewerkt:
Code: 
activewindow.scrollcolumn= 1
 
De code van #37 heb ik toegevoegd ipv
Maar het blad "Planning" wordt niet geactiveerd. De boosdoener lijkt

Code: 
    activewindow.scrollrow= .Cells(ga_naar, 4).Offset(1).Row

Als ik de oude versie terug plaats wordt dat blad wel geactiveerd maar is het beeld niet naar wens.
 
Code: 
Dim ga_naar
With Sheets("Planning")
  .activate
 
Juist. Opgelost !

Hartelijk dank weer.

Volledige code:

Code: 
Sub Workbook_Open()
Dim ga_naar
With Sheets("Planning")
  .Activate
  .Columns(4).AutoFit
 ga_naar = Application.Match(Application.Max(.Columns(4)), .Columns(4), 0)
20    ActiveWindow.ScrollRow = .Cells(ga_naar, 4).Offset(-10).Row
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
End With
End Sub

Regel 20 toch weer moeten terugdraaien naar #35 (zoekende cel werd niet gevonden)
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan