plaats besturingselement

Status
Niet open voor verdere reacties.
Plotinus

Plotinus

Gebruiker
Lid geworden
25 mrt 2007
Berichten
649
Ik heb een datumkiezer gemaakt m.b.v. een formulier. Als ik nu een cel selecteer in een bepaald bereik, dan verschijnt die datumkiezer op het scherm en staat mij toe een datum te selecteren en in de actieve cel te plaatsen. Echter, de datumkiezer verschijnt steeds enkel in het midden van het scherm; ik zou het graag juist onder of naast (weet het nog niet hoe het uitkomt) de actieve cel hebben. Iemand een idee hoe ik dit aanpak?
 
Moeilijk. Er zijn wel enkele benaderingen voor, maar het is erg complex dit perfect te doen. Dit heeft te maken met dat schermpunten niet overeen komen met cell punten.

Als een cell de coordinaten heeft van 100,100 dan is dat de afstand vanaf de linkerbovenhoek van de sheet. Echter staat daar nog de ribbon tussen en de excel applicatie is vrij verplaatsbaar over je scherm. Dat betekend dat je 100,100 aan cel coordinaten moet omzetten naar de werkelijke positie op het scherm van de cel. Je kan dat doen door de relatieve coordinaten van de cel te gokken tov de beeldschermcoordinaten van de linker bovenhoek van de applicatie.
 
Als je de plaats van die datumkiezer zelf kunt bepalen zou ik hem over de cel naast de actieve cel laten verschijnen. Dus met de top left coördinaten:
Activecell.Top en Activecell.Offset(0,1).left
 
En hoe pak ik dat concreet aan Edmoor? Ik heb mijn datumprikker (gevonden op internet en enigszins aangepast) bijgevoegd als voorbeeld wat ik concreet wil. In sheet 1 zou je in het bereik A1 t/m D10 de datumprikker moeten zien verschijnen en een datum moeten kunnen kiezen. Omdat ik de gebruiker op diverse plaatsen een datum wil laten kiezen vind ik het elegant als het dichtbij de actieve cell verschijnt.
 

Bijlagen

  • voorbeeld-kalendewr.xlsm
    22,9 KB · Weergaven: 84
Ik wil graag voor je kijken maar dan heb ik naast dat document ook het object MonthView van je nodig.
 
Mijn 'gepruts' is gebaseerd op wat ik hier heb gevonden: http://www.fontstuff.com/vba/vbatut07.htm. Maar ik ben er zojuist achtergekomen dat er in versie 2010 probelemen zijn met het Monthview; ik werk dus nog in 2007 en daar is het gewoon als extra/meer besturingselementen binnen te halen.
 
Het is inderdaad een stuk lastiger dan ik verwacht had, en wampier al opmerkte, maar Chip Pearson heeft het moeilijke werk al gedaan. Zijn routines heb ik in je document verwekt en het formulier met de kalender verschijnt nu 2 cellen onder de geselecteerde cel. Probeer eens of dit is wat je wilt en anders moet je maar even het verhaal van Chip Pearson bestuderen en zijn module in dit document bekijken.

Bekijk bijlage voorbeeld-kalendewr.xlsm
 
Laatst bewerkt:
Ik ken het werk van Chip. Echter is deze ook niet waterdicht. De code is niet portable tussen versies en geeft problemen als je met twee schermen werkt. Ook gebruik op tablets e.d. wordt niet ondersteund.

Dat is dus overigens een beperking van VBA, niet het fantastische werk van Chip en consorten.

Overigens kan het wel met windowhandles je hebt dan de exacte informatie, maar is ook niet altijd ideaal.
 
Chip zegt ook zelf dat het niet onder alle omstandigheden werkt. Ik ga er niet naar zoeken want als Chip dat al gedaan heeft zal ik geen betere oplossing vinden ;)
 
Via HWND wordt het zoiets:

Code: 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Sub bovenhoekmap1()
    Dim hwnd As Long
    Dim fnd As Long
    fnd = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
    If fnd <> 0 Then
        Dim myrect As RECT
        hwnd = FindWindowEx(fnd, 0&, "XLDESK", vbNullString)
        hwnd = FindWindowEx(hwnd, 0&, vbNullString, vbNullString)
        
        rv = GetWindowRect(hwnd, myrect)
        Dim def As New UserForm1
        def.Left = myrect.Left * 0.75
        def.Top = myrect.Top * 0.75
        def.Show
    End If
End Sub

Deze heeft minder last van de nadelen van chip versie. deze simpele versie werkt alleen met de eerste excel server en de eerste werkmap. Het plaatst een userform altijd linksboven in de hoek van excel1->map1 . Als je het algemeen bruikbaar wil maken moet je eigenlijk door alle excel servers en alle mappen itereren om zeker te zijn dat je aligned met de juiste werkmap.

*edit* bovendien is de 0.75 verkleiningsfactor in principe niet vast en zou je ook de screensettings moeten uitlezen om zeker te zijn dat dat nog juist is. Dus om dit perfect te krijgen is ook niet triviaal.
 
Laatst bewerkt:
Ik gebruik de Window Hooks nooit omdat het vaak nogal problemen geeft in debug mode. Zodanig dat F8 niet kan worden gebruikt en dat is in grotere projecten heel erg lastig. Ben benieuwd wat TS hiervan vind :)
 
Laatst bewerkt:
Verbeterde versie (met alleen DPI open) mocht iemand dat ooit interessant vinden:

Code: 
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Sub topleft()
    Dim hwnd As Long
    Dim fnd As Long
    Dim AWB As Long
    Dim naam As String
    
    fnd = Application.hwnd
    Dim myrect As RECT
    fnd = FindWindowEx(fnd, 0&, "XLDESK", vbNullString)
    hwnd = FindWindowEx(fnd, 0&, vbNullString, vbNullString)
    While hwnd <> 0
        naam = String$(100, Chr$(0))
        rv = GetWindowText(hwnd, naam, 100)
        If Left$(naam, rv) = ActiveWorkbook.Name Then
            AWB = hwnd
        End If
        hwnd = FindWindowEx(fnd, hwnd, vbNullString, vbNullString)
    Wend
    rv = GetWindowRect(AWB, myrect)
    Dim def As New UserForm1
    def.Left = myrect.Left * 0.75
    def.Top = myrect.Top * 0.75
    def.Show
End Sub
 
Hartelijk dank edmoor en wampier, maar ik heb na lang zoeken een lelijkere, maar betere lossing (denk ik) gevonden. Het grote voordeel is dat het zeer klein is precies doet wat ik wil en heel gemakkelijk aan te passen aan het bereik wat ik wil openstellen voor datums. Werkt voor zover na te gaan enkel in 2007, maar dat is even genoeg. Hierbij gevoegd.

De oplossing van edmoor werkte helaas niet bij mij en bevat een berg code. De datumpicker bleek verdwenen van Userformen het lukt me niet meer deze terug te plaatsen; heel vreemd.
 

Bijlagen

  • Datepicker.xls
    42,5 KB · Weergaven: 51
Laatst bewerkt:
Inmiddels oplossing van edmoor toch werkend gekregen, vertekkende van mijn eigen sheet en dan de code overzetten; lijkt me dus wel heel kwetsbaar. Maar het werkt precies zoals ik wil. Ik vraag me af waar de aanvulling van wampier voor nodig is en hoe en waar ik die moet plaatsen(?) Wat is DPI trouwens; je zult wel niet dots per inch bedoelen denk ik.
 
Ja dots per inch. samen met PPI (pixels per inch) geeft dat de benodigde verhouding. Standaard windows PPI = 96. standaard DPI = 72.

Verhouding pixels / beeldpunten = 72/96 = 0,75

Mijn aanpassing is misschien niet direct van belang voor je. Wat mijn functie doet is de locatie van de linkerbovenhoek van het active window vinden. Vervolgens kun je dat gebruiken met de top/left van de cel. Het werkt ongeveer zoals de functie van edmoor, MAAR het werkt ook als je "cascade" windows gebruikt en werkt over meerdere schermen. zolang je fullscreen werkt in een enkele excel instance op een enkel scherm is het effectief hetzelfde.
 
Dank je; helder, maar waar moet ik wat vervangen? edmoor heeft nogal veel toegevoegd. Zoals je wel begrepen zult hebben, begrijp ik niet alle code die mij wordt toegestuurd...

Ik werk afwisseld met één en twee schermen, dus de aanpassing is welkom, maar noodzakelijk ook weer niet. Ik werk nu thuis op één scherm, dus uittesten met twee schermen gaat even niet.
 
Als je het echt interessant vind kan ik daar morgen of zo nog wel eens naar kijken. Overigens gaat het dus niet altijd fout. Mijn code is meer een alternatieve manier om een functie toe te voegen die er, mijns inziens, gewoon standaard in had moeten zitten.
 
graag, misschien wil je daarvoor mijn eerder toegestuurd document gebruiken die edmoor ook heeft gebruikt. Ik ga de beide oplossingen dan eens naast elkaar zetten en testen en proberen te begrijpen. Ik ben heel benieuwd!
 
Bij deze. Heb wat moeten cheaten met het calender object. Let op, de code is niet zo robuust als die van chip, maar dat zou in dit geval niet veel uit moeten maken (deze specifieke toepassing).

resultaat is ongeveer hetzelfde, maar met 30 regels code ipv 600

Bekijk bijlage voorbeeld-kalender wa.xlsm

PS, dat veranderd overigens niets aan de nette oplossing van chip die in principe ook op de windows rs versie van office zou kunnen werken of de mac versie. Dit is een pure windowshack die een missende functie toevoegt.
 
precies wat mij voor ogen stond, klein en lenig; hartelijk dank, ook edmoor natuurlijk.

Wat mij wel zorgen baart, is dat ik frmcalandar weer opnieuw moest definieren, want het kwam dit keer wel mee, maar verminkt (sterk in elkaar gekrompen en niet actief). Ik hoop dat het straks door iedereen in onze organisatie zonder problemen te gebruiken is. In dit geval gelukkig dat we nog in 2007 werken.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan