Coördinaten van, bv een getekende lijn, dmv VBA opvragen.

[Streuby]

Hallo, ik zou graag van een in een excelformulier getekende lijn of polylijn, de coördinaten (BeginX, EndX, BeginY, EndY) opvragen en in cellen plaatsen.

De bedoeling is dus dat ik in excel een lijn ga tekenen en dat ik met een macro of dmv een knop, de coördinaten of parameters van deze lijn kan inlezen zodat ik deze exacte lijn later terug met een in VBA geschreven programma kan terug plaatsen. Ik wil dus van bepaalde tekeningen in excel (en nee excel is geen tekenprogramma) enkel de coördinaten opslaan en niet de gehele tekening.

Dank bij voorbaat.

 

[cow18]

Hoe komen die lijnen daar ? Via invoegen>vormen of op een andere manier ?
Post anders eens een voorbeeldje.

 

[Streuby]

Ik plaats de lijnen via invoegen> Vormen en ik plaats ze in een werkblad met een plotplan (zeg maar een plattegrond) als watermerk. De bedoeling is dat ik dmv die lijnen een soort 'route' weergeef. Die 'route' moet bewaard kunnen worden. Het zou daarom makkelijk zijn mocht ik van die lijnen de coördinaten kunnen wegschrijven naar een verborgen excel blad zodat ik dmv een UserForm of een formulier, het blad met de juiste achtergrond (watermerk) terug kan oproepen en de bepaalde 'route' (lijn) ten aller tijden terug kan weergeven. Ik heb nog geen voorbeeld, alleen maar wat losse ideeën en stukken van de puzzel.
Het idee met de lijnen via invoegen>vormen is één van die ideeën maar ook dit staat niet geheel op punt.
En waarom in excel? Het gaat niet echt om de tekeningen en bijkomend aan de 'route' beschrijving moeten er nog veel gegevens toegevoegd worden. ik moet deze gegevens ook op een eenvoudige, overzichtelijke manier kunnen terugvinden en weergeven en Excel is daarbij voor mij de beste tool.
Ik ben zeker geen expert in VBA maar ik kan hier over het algemeen aardig m'n weg in vinden al moet ik soms wel de raad of advies van echte kenners inroepen.

 

[snb]

Voorbeeld vergeten toe te voegen ?

 

[Streuby]

Ik zoek een programma in VBA waarmee ik het volgende kan bereiken:





En zo verder voor de 3e muisklik, 4e muisklik, enz…

Ik weet hoe ik de coördinaten van de cursor kan weergeven, maar dat zijn de coördinaten tov het scherm en niet tov het werkblad. De juiste positie op het werkblad is zeer belangrijk en voor later gebruik, moet ik deze coördinaten kunnen opslaan.

 

[daan108]

Onderstaande voorbeeldje geeft de coordinaten van cel A1 en de coordinaten (linksboven) van een shape op het werkblad. Beiden zijn t.o.v. de linkerbovenhoek van het werkblad (merk op dat cel A1 coordinaten 0, 0 als resultaat geeft). Dus maakt niet uit waar het werkblad zich op het scherm bevindt. De coordinaten rechtsonder zijn zelfde als coordinaten linksboven met daarbij de breedte en hoogte van het object opgeteld.

Sub coords()
Set Rng = Cells(1, 1)
x = Rng.Left
y = Rng.Top
MsgBox x & "  " & y
With ActiveSheet.Shapes(1)
    x = .Left
    y = .Top
End With
MsgBox x & "  " & y
End Sub

For starters:

Sub get_coords_of_shapes()
i = 1  ' rijnummer data schrijven
j = 10 ' kolomnummer data schrijven
Range(Cells(1, j), Cells(1, j + 5).End(xlDown)).ClearContents
heads = Array("x0", "y0", "x1", "y1", "Naam", "Lijnkleur")
Range(Cells(i, j), Cells(i, j + 5)).Value = heads
For Each shp In ActiveSheet.Shapes
    i = i + 1
    x = shp.Left
    y = shp.Top
    Cells(i, j) = x
    Cells(i, j + 1) = y
    Cells(i, j + 2) = x + shp.Width
    Cells(i, j + 3) = y + shp.Height
    Cells(i, j + 4) = shp.Name
    Cells(i, j + 5) = shp.Line.BackColor
Next
End Sub

Opmerkingen:
- je krijgt zo een lijst van álle shapes op het werkblad
- ik zag dat de naam door VBA in het Engels gegeven is maar in mijn Nederlandse versie van Excel is de naam in de linkerbovenhoek in het Nederlands
- door j aan te passen kun je de lijst buiten beeld van je kaart laten zetten
- je kunt natuurlijk van alles van de shape opvragen, lijndikte bijvoorbeeld
- als je een polygoon als figuur hebt (vrije vorm) dan heb je hiermee niet de tussenliggende punten, sterker, alleen de hoekpunten linksboven en rechtsonder van de omhullende rechthoek.

 

[Streuby]

Hoi daan108,

Bedankt voor uw reactie en de door u geboden oplossing.
Ondertussen heb ik zelf deze code gevonden:

Sub Coördinaten()
 

With ActiveWindow.Selection.ShapeRange(1)
 a = .Left
 b = .Top
 c = .Width
 f = .Height
 d = .Left + .Width
 e = .Top + .Height
End With

Worksheets("Blad1").Range("A1").Value = a
Worksheets("Blad1").Range("A2").Value = b
Worksheets("Blad1").Range("A3").Value = c
Worksheets("Blad1").Range("A4").Value = d
Worksheets("Blad1").Range("A5").Value = e
Worksheets("Blad1").Range("A6").Value = f
    
End Sub

Ik heb nu, mede dankzij u, een manier gevonden om de coördinaten van een figuur te vinden (en weg te schrijven).
Het is spijtig dat ik bij de "polygoon" enkel de hoekpunten krijg want, gezien ik deze exacte figuur terug wil construeren, heb ik de tussenliggende punten eigenlijk ook nodig.
Ik zoek ook nog naar een manier om de positie van de cursor tov het werkblad te vinden. De methode om de positie tov het scherm te vinden heb ik al.
Mocht ik hiervoor een oplossing vinden, dan hoef ik geen tekening te maken en volstaat het om gewoon de begin-, tussenliggende- en eindpunten aan te klikken.
Ik kan dan op het gewenste moment met deze gegevens de lijnen of figuren door VBA laten tekenen.

 

[daan108]

Hiermee krijg je de coordinaten X en Y van alle punten van een vrije vorm (inclusief begin- en eindpunt):

Sub xy_nodes_vrije_vorm()
Set shp = ActiveSheet.Shapes(2)  '  <<< shape nummer
With shp.Nodes
    If .count > 0 Then
        For it = 1 To .count
            crds = .Item(it).Points
            X = crds(1, 1)
            Y = crds(1, 2)
        Next
    End If
End With
End Sub

Ik begrijp niet wat je bedoelt met schermcoordinaten, genoemde functies geven de coordinaten t.o.v. de linkerbovenhoek van het Excel-werkblad. Wil je met de muis over het scherm bewegen en dat je in Excel ziet welke Excel-coordinaten daarbij horen?

 

[daan108]

Er bestaat een programmaatje om op een afbeelding te klikken en coordinaten te bewaren. Zoek op Google naar "Grab it Excel".

 

[Streuby]

Met deze code:

Declare PtrSafe Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long

Type POINTAPI
   X_Pos As Long
   Y_Pos As Long
End Type

Sub Get_Cursor_Pos()
  

Dim Hold As POINTAPI

      MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
       "Y Position is : " & Hold.Y_Pos

End Sub

Krijg ik de positie van de cursor maar deze komt niet overeen met de coördinaten t.o.v. de linkerbovenhoek van het Excel-werkblad.

Ik zou dus na een muisklik ergens, in het excel-werkblad, de coördinaten van de cursor willen krijgen.

 

[VenA]

Ik zie nog steeds geen voorbeeldbestand. En plaats code tussen codetags.

 

[Streuby]

En daan108, de code die u gaf voor de coordinaten X en Y van alle punten van een vrije vorm, werkt perfect.
U hebt me hier een grote dienst mee bewezen. Dank u.

 

[Streuby]

Beste VenA, omdat dit allemaal maar losse puzzelstukken naar mijn oplossing zijn, kan ik u niet meer sturen dan datgene dat ik in reactie (#5) gestuurd heb en m'n excuses voor het verkeerd posten van m'n code.
Ik ben hier nieuw en merk, door uw reactie, nu pas de "codetag" functie op.

Declare PtrSafe Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long

Type POINTAPI
X_Pos As Long
Y_Pos As Long
End Type

Sub Get_Cursor_Pos()


Dim Hold As POINTAPI

MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
"Y Position is : " & Hold.Y_Pos

End Sub

 

[VenA]

In #5 staan alleen 2 plaatjes. In #3 schrijf je oa

Ik plaats de lijnen via invoegen> Vormen en ik plaats ze in een werkblad met een plotplan (zeg maar een plattegrond) als watermerk.

En daar heb je geen bestand van?

 

[daan108]

Maar als je de beeldschermcoördinaten hebt, dan ben je er toch ook? Want alle onderdelen zijn dan ten opzichte van elkaar altijd goed. Je kunt tijdens het klikken alleen niet schalen en schuiven, en heel je kaart moet op het scherm passen.
Dan lijkt het me beter om een polygoon in Excel in te voegen, te laten onthouden wat al zijn coördinaten zijn, en als het er goed uitziet de polygoon weer te verwijderen. Dat is hetzelde als klikken zonder dat je met een vorm bezig bent en de punten op te slaan. Het eerste is echter beter want dan kun je nog inzoomen en schuiven, en als je ernaast geklikt hebt, zie je het meteen. Trouwens, je wílde zelf toch ook nou juist de werkbladcoördinaten?

 

[Piet Bom]

Hierbij een voorbeeld van mijn Staalconstructie tekening in Excel
Ik gebruik dat om de staalconstructie door te rekenen op sterkte en doorbuiging.

 

[Streuby]

Ik wil iedereen bedanken voor de reacties en de geboden oplossingen. Ik kan verder met mijn project.

daan108, mijn werkvlak overschrijdt het weergegeven werkblad op het beeldscherm dus ik moet sowieso schuiven. Ik kan het beeld wel verkleinen maar dit gaat ten koste van de gebruiksvriendelijkheid.
De beelschermcoördinaten bieden dus geen oplossing. De code die u me gestuurd hebt, helpt me een heel eind vooruit. Waarvoor dank.

VenA, ik kan hier wel een voorbeeld posten van mijn werkblad en het watermerk, maar ik vrees dat dit niet relevant is. Ik zocht enkele een maner om de coördinaten van een getekende lijn te bepalen en op te slagen. Ik wil u wel bedanken voor uw interesse en uw bijdrage. Dankzij u weet ik iets meer over de manier van hoe men hier te werk gaat (gebruik codetag ;-) )

Piet Bom, ik heb uw bestandje ook eens bekeken en ik vrees dat ik er niet echt veel mee vooruit ben maar er zitten zeker zaken in die ik misschien later nog kan gebruiken.

Gezien mijn vraag beantwoord is en ik een oplossing ontvangen heb, ga ik deze vraag als "opgelost" afsluiten.