Macro to Draw Object- A Blue Line

[coliervile]

Hello to all it's been a while since I've been on and I hope everyone is doing well? :hi:

I want a macro to draw a blue line (2.0 pt thick) starting from a lower left corner of a specific cell to the end of the mouse cursor when the mouse is left click. The macro would be activated from a button (see attached worksheet) on the worksheet and the blue line drawn when the mouses is left clicked. Hopefully I've explained this well enough.

[mdmackillop]

Hi Charlie,
Not quite the way you asked, but maybe a way forward. It uses Double-Click and a prompt for a cell address.
Regards
MD


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
CurPos
End Sub


'In standard sub

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

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

Dim pos As POINTAPI ' Declare variable


Sub CurPos()
'Thanks to Colo
'http://www.puremis.net/excel/cgi-bin/yabb/YaBB.pl?num=1116898166

Dim X As Long, Y As Long
Dim Rg As Range, tgt As Range

'Get cursor position
GetCursorPos pos
a = pos.X
b = pos.Y

'Get Position of A1
Set Rg = Range("A1")
X = ActiveWindow.PointsToScreenPixelsX((Rg.Left) * 96 / 72 * ActiveWindow.Zoom / 100)
Y = ActiveWindow.PointsToScreenPixelsY((Rg.Top) * 96 / 72 * ActiveWindow.Zoom / 100)
Call SetCursorPos(X, Y)

GetCursorPos pos
c = pos.X
d = pos.Y

'Adjust for screen setup
X1 = (a - c) * 72 / 96 * 100 / ActiveWindow.Zoom
Y1 = (b - d) * 72 / 96 * 100 / ActiveWindow.Zoom

'Return cursor to oroiginal position
Call SetCursorPos(a, b)

'Get corner of start cell
Set Rg = Range(InputBox("Enter cell")).Offset(1)
X = Rg.Left
Y = Rg.Top

'Draw line
With ActiveSheet.Shapes.AddLine(X, Y, X1, Y1).Line
.ForeColor.RGB = RGB(0, 0, 255)
.Weight = 2
End With

End Sub

[coliervile]

Thanks MD for your suggestion. Unfortunately I have a double click feature in the workbook and it would interfere with that. I did come up with some thing that works but, not exactly the way I want it to. I'm still curious if I can get my original idea to work as well???

[coliervile]

MD I'm getting a compile error when I run your coding at this location ""Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long"".

[mdmackillop]

Now with Option Explicit!

[coliervile]

MD that is exactly what I was looking for. Is there a way that your coding can be adjusted for a larger range, for example Sheet2 on the attachment is a copy of the actual scorecard worksheet. As you can see there are 118 different ballfields and I would like to use your coding on all of them.

[mdmackillop]

The uses for Excel never cease to amaze me!
I'm sure we can do that.
Can you conform that
1. you are drawing the line to a point in each green area
2. the starting point is the same in each grid, which is bottom left of K10 etc.
3. you use each grid in turn, what about no-line grids?

[coliervile]

Good day to you Sir and I agree with your statement-

The uses for Excel never cease to amaze me!


To answer your questions;

Can you conform that
1. you are drawing the line to a point in each green area- YES
2. the starting point is the same in each grid, which is bottom left of K10 etc.- from the bottom left of K11, T11, K20, and K29 and so on (using the examples from worksheet2).

Thanks for your time and assistance.

[mdmackillop]

This needs a bit more thought! I guess you need to freeze portions of the screen to use this. That obviously moves absolute positions. I'll need to think how to make these work as relative positionss.

[coliervile]

Thanks MD for taking the time to work on this. What's even more amazing on how Excel is used, even abused, is that you fine folks at VBA Express seem to always come up with a solution and/or answer to our questions/issues/problems no matter how goofy they seem to be. BRAVO TO ALL OF YOU AT VBA EXPRESS!!!

[mdmackillop]

I think I've got the start position sorted, but am having trouble with the cursor postion relative to this. Any suggestions welcome

[coliervile]

I see what you mean. As you go further down the worksheet the line gets longer too. I'm uncertain of how to help you here you need a more knowledgable Excel Expert than me.

[mdmackillop]

Getting there, but needs fixing for Zoom and different frozen views.

[coliervile]

Good morning to all. Hey MD looking good thus far, it's exactly what I was hoping for. I've got to go through the coding so I can understand what's going on and how things work. I see what you mean about the zooming in/out when using the macros.

[coliervile]

Hello MD did you have the opportunity to look at how to tweak the zoom???

[coliervile]

Does anyone have any ideas To Mr. "mdmackillop" blog #13.. on how to tweak the following "but needs fixing for Zoom and different frozen views". When the macro's are run from a different zoom, other than 100%, the lines aren't drawn to the mouse cursor as the are suppose to.

[coliervile]

Good morning, Does anyone have an idea on Post number 16???