Hi all,
I measure distances, areas, etc. on a drawing inserted on a Sheet
using the coordinates when the mouse was clikced. However, If I click
on coordinate, say (450,370) I would like a wingding to be placed on
that coordinate as a reminder that I've already clicked on that spot
on the drawing. Is it possible? I don't now here to start probramming
this. Thanks in advance

On Aug 17, 2:15*am, Pierre wrote:
Hi all,
I measure distances, areas, etc. on a drawing inserted on a Sheet
using the coordinates when the mouse was clikced. However, If I click
on coordinate, say (450,370) I would like a wingding to be placed on
that coordinate as a reminder that I've already clicked on that spot
on the drawing. Is it possible? I don't now here to start probramming
this. Thanks in advance

Here is my feeble attempt to place wingding on "Picture1": Obviously
it does not work since I do not have the sytax to place the wingding
at certain coordinates (pPosition.X and pPosition.Y) instead of a
certain cell on the Sheet.

Directives would be greatly appreciated


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

Type POINTAPI
X As Long
Y As Long
End Type

Sub TEST1()
Application.ScreenUpdating = False
Dim pPosition As POINTAPI

Dim lReturn As Long
Dim ROW As Integer

Application.Cursor = xlNorthwestArrow

Range("T5").Select
lReturn = GetCursorPos(pPosition)


'PLACE THE VALUE OF X IN CELL T5
ActiveCell.Value = pPosition.X

'PLACE THE VALUE OF Y IN CELL U5
ActiveCell.Offset(0, 1).Value = pPosition.Y

'PLACE THE VALUES OF X AND Y IN COLUMNS AD AND AE FOR
'FURTHER MANIPULATION, I.E. DISTANCE BETWEEN CLICKS, ETC

ActiveCell.Offset(0, 10).Select

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

ROW = 4

ActiveCell.Value = pPosition.X
ActiveCell.Offset(0, 1).Select
Selection.Value = pPosition.Y

Application.ScreenUpdating = True


''PLACE WINGDING ON THE X AND Y POSITION

Debug.Print Application.Rept(Chr(116), 1)


End Sub

In addition to your GetCursorPos (search this group) pixels to points
(search this group). Thereafter you need a way to determine when you've
pressed your mouse. Two approaches, the first is to subclass windows and
check windows events, trouble is that's a bit risky in VBA particularly if
you try debugging. Another way would be with a timer (search SetTimer,
AddressOf, KillTimer). The timer proc would call a routine to check the
button state of your mouse, looking first for a mouse down then a mouse up
(or vica versa), search "mouse_event" for examples and flags. I'll leave all
that to you but I thinks there's enough in the search terms to put it all
together.

A much simpler way perhaps would be to put your picture on a chart, or
format the chartarea with your picture (fill effects / picture).

Then, with the chart active, you can get a withevents chart class running
and trap one of the mouse events. That'll give you your XY "point" co-ords
with which you can insert (or copy/paste) a picture of your WingDing (I take
it that's a picture of a wingding character) and position to center over the
XY. Perhaps track XY with mouse move and apply your image with a keyboard
event to avoid getting popups.

Regards,
Peter T



"Pierre" wrote in message
...
Hi all,
I measure distances, areas, etc. on a drawing inserted on a Sheet
using the coordinates when the mouse was clikced. However, If I click
on coordinate, say (450,370) I would like a wingding to be placed on
that coordinate as a reminder that I've already clicked on that spot
on the drawing. Is it possible? I don't now here to start probramming
this. Thanks in advance

On Aug 17, 11:52*pm, "Peter T" <peter_t@discussions wrote:
In addition to your GetCursorPos (search this group) pixels to points
(search this group). Thereafter you need a way to determine when you've
pressed your mouse. Two approaches, the first is to subclass windows and
check windows events, trouble is that's a bit risky in VBA particularly if
you try debugging. Another way would be with a timer (search SetTimer,
AddressOf, KillTimer). The timer proc would call a routine to check the
button state of your mouse, looking first for a mouse down then a mouse up
(or vica versa), search "mouse_event" for examples and flags. I'll leave all
that to you but I thinks there's enough in the search terms to put it all
together.

A much simpler way perhaps would be to put your picture on a chart, or
format the chartarea with your picture (fill effects / picture).

Then, with the chart active, you can get a withevents chart class running
and trap one of the mouse events. That'll give you your XY "point" co-ords
with which you can insert (or copy/paste) a picture of your WingDing (I take
it that's a picture of a wingding character) and position to center over the
XY. Perhaps track XY with mouse move and apply your image with a keyboard
event to avoid getting popups.

Regards,
Peter T

"Pierre" wrote in message

...



Hi all,
I measure distances, areas, etc. on a drawing inserted on a Sheet
using the coordinates when the mouse was clikced. However, If I click
on coordinate, say (450,370) I would like a wingding to be placed on
that coordinate as a reminder that I've already clicked on that spot
on the drawing. Is it possible? I don't now here to start probramming
this. Thanks in advance- Hide quoted text -

- Show quoted text -

Thanks, for the the info. Peter. Now I know where to start
researching. The WingDing is a diamond shaped character. My "picture"
is normally a building plan in PDF ( sometimes JPG - if scanned) and
I wiil try and instert the PDF in a chart as you suggested but I'm not
sure if that's possible. Thanks very much for the interest anuway.
Pierre

I wasn't concentrating when I gave those search terms, at best not enough
and at worst misleading. One thing I forgot to mention is you'd need to
relate your cursor co-ords to the zero point co-rod position on the sheet,
doable but more work.

I don't see any reason why you can't put your picture into a chart (don't
think you need all that PDF).
- Insert your picture onto a sheet
- create an empty chart and size a little larger than your picture
- cut your picture
- select the chart (ensure you get filled handles)
- paste the picture into the chart

Here's some code to get you started (normal module and class module as
indicated)
Assumes Sheet3 is empty but see GetWingDingPic() to change

Select your chart, and run SetChart()

With the chart selected press left button and Ctrl to paste a the wingding
picture (or Ctrl-Alt to delete them)

While the ref "mcChart" maintains scope you can deactivate and reactivate
the chart


'''' code in a normal module

Dim mcChart As clsChtEvents

Sub SetChart()
Dim cht As Chart
' if will either reference the activechart
' or the first embedded chart on the sheet

On Error Resume Next
Set cht = ActiveChart

If cht Is Nothing Then
Set cht = ActiveSheet.ChartObjects(1).Chart
End If

If Not cht Is Nothing Then
Set mcChart = New clsChtEvents
Set mcChart.cht = cht Else
MsgBox "no chart on sheet"
End If

End Sub

Sub MakeWingDingPic(Optional s As String = "J")
Dim cel As Range
Dim pic As Picture
Dim ws As Worksheet

' an unused or hidden sheet
Set ws = Worksheets("Sheet3") ' << CHANGE if necessary

On Error Resume Next
Set pic = ws.Pictures("picWingDing_" & s)
On Error GoTo 0
If pic Is Nothing Then
ws.Pictures.Delete
Set cel = ws.Range("D4")
With cel
.Columns(1).Clear
.Font.Name = "WingDings"
.Font.Color = vbRed
'.Font.Bold = True
.Font.Size = 16
.Value = s
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns(1).EntireColumn.AutoFit
.Interior.ColorIndex = xlNone
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With

ws.Pictures.Paste

Set pic = ws.Pictures(ws.Pictures.Count)
With cel.Offset(, 2)
pic.Left = .Left
pic.Top = .Top
End With

pic.Name = "picWingDing_" & s
End If

pic.CopyPicture Appearance:=xlScreen, Format:=xlPicture

End Sub

'''' end normal module

''''' code in a class named "clsChtEvents"

Public WithEvents cht As Excel.Chart
Private mbFlag As Boolean

' typically points per pixel is 72/96
' but should confirm with API
Const PP As Single = 0.75
Const mcPrefix As String = "picWD_"

Private Sub cht_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
Dim pic As Picture
Const FF As Single = -3 ' a fudge factor, experiment !

If Button = 1 And Shift = 2 Then 'left button & Ctrl
MakeWingDingPic
cht.Pictures.Paste
Set pic = cht.Pictures(cht.Pictures.Count)
With pic
.Left = x * PP - .Width / 2 + FF
.Top = y * PP - .Height / 2 + FF
End With
NamePic pic
mbFlag = True
cht.ChartArea.Select ' try and deselect the picture
ElseIf Shift = 6 Then ' Alt-Ctrl ' delete the pic's
DelWDpics
End If

End Sub

Private Sub cht_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
If mbFlag Then
mbFlag = False
cht.ChartArea.Select
End If
End Sub

Sub NamePic(pic As Picture)
Dim p As Picture
Dim i As Long
On Error Resume Next
Do
i = i + 1
Set p = cht.Pictures(mcPrefix & i)
Loop Until Err.Number 0
pic.Name = mcPrefix & i
End Sub

Sub DelWDpics()
Dim p As Picture
For Each p In cht.Pictures
If InStr(p.Name, mcPrefix) = 1 Then
p.Delete
End If
Next
End Sub

'''' end class clsChtEvents


Regards,
Peter T

On Aug 18, 12:17*pm, "Peter T" <peter_t@discussions wrote:
I wasn't concentrating when I gave those search terms, at best not enough
and at worst misleading. One thing I forgot to mention is you'd need to
relate your cursor co-ords to the zero point co-rod position on the sheet,
doable but more work.

I don't see any reason why you can't put your picture into a chart (don't
think you need all that PDF).
- Insert your picture onto a sheet
- create an empty chart and size a little larger than your picture
- cut your picture
- select the chart (ensure you get filled handles)
- paste the picture into the chart

Here's some code to get you started (normal module and class module as
indicated)
Assumes Sheet3 is empty but see GetWingDingPic() to change

Select your chart, and run SetChart()

With the chart selected press left button and Ctrl to paste a the wingding
picture (or Ctrl-Alt to delete them)

While the ref "mcChart" maintains scope you can deactivate and reactivate
the chart

'''' code in a normal module

Dim mcChart As clsChtEvents

Sub SetChart()
Dim cht As Chart
* * ' if will either reference the activechart
* * ' or the first embedded chart on the sheet

* * On Error Resume Next
* * Set cht = ActiveChart

* * If cht Is Nothing Then
* * * * Set cht = ActiveSheet.ChartObjects(1).Chart
* * End If

* * If Not cht Is Nothing Then
* * * * Set mcChart = New clsChtEvents
* * * * Set mcChart.cht = cht * *Else
* * * * MsgBox "no chart on sheet"
* * End If

End Sub

Sub MakeWingDingPic(Optional s As String = "J")
Dim cel As Range
Dim pic As Picture
Dim ws As Worksheet

* * ' an unused or hidden sheet
* * Set ws = Worksheets("Sheet3") ' << CHANGE if necessary

* * On Error Resume Next
* * Set pic = ws.Pictures("picWingDing_" & s)
* * On Error GoTo 0
* * If pic Is Nothing Then
* * * * ws.Pictures.Delete
* * * * Set cel = ws.Range("D4")
* * * * With cel
* * * * * * .Columns(1).Clear
* * * * * * .Font.Name = "WingDings"
* * * * * * .Font.Color = vbRed
* * * * * * '.Font.Bold = True
* * * * * * .Font.Size = 16
* * * * * * .Value = s
* * * * * * .HorizontalAlignment = xlCenter
* * * * * * .VerticalAlignment = xlCenter
* * * * * * .Columns(1).EntireColumn.AutoFit
* * * * * * .Interior.ColorIndex = xlNone
* * * * * * .CopyPicture Appearance:=xlScreen, Format:=xlPicture
* * * * End With

* * * * ws.Pictures.Paste

* * * * Set pic = ws.Pictures(ws.Pictures.Count)
* * * * With cel.Offset(, 2)
* * * * * * pic.Left = .Left
* * * * * * pic.Top = .Top
* * * * End With

* * * * pic.Name = "picWingDing_" & s
* * End If

* * pic.CopyPicture Appearance:=xlScreen, Format:=xlPicture

End Sub

'''' end normal module

''''' code in a class named "clsChtEvents"

Public WithEvents cht As Excel.Chart
Private mbFlag As Boolean

' typically points per pixel is 72/96
' but should confirm with API
Const PP As Single = 0.75
Const mcPrefix As String = "picWD_"

Private Sub cht_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
Dim pic As Picture
Const FF As Single = -3 * *' a fudge factor, experiment !

* * If Button = 1 And Shift = 2 Then * *'left button & Ctrl
* * * * MakeWingDingPic
* * * * cht.Pictures.Paste
* * * * Set pic = cht.Pictures(cht.Pictures.Count)
* * * * With pic
* * * * * * .Left = x * PP - .Width / 2 + FF
* * * * * * .Top = y * PP - .Height / 2 + FF
* * * * End With
* * * * NamePic pic
* * * * mbFlag = True
* * * * cht.ChartArea.Select * *' try and deselect the picture
* * ElseIf Shift = 6 Then ' Alt-Ctrl ' delete the pic's
* * * * DelWDpics
* * End If

End Sub

Private Sub cht_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
* * If mbFlag Then
* * * * mbFlag = False
* * * * cht.ChartArea.Select
* * End If
End Sub

Sub NamePic(pic As Picture)
Dim p As Picture
Dim i As Long
* * On Error Resume Next
* * Do
* * * * i = i + 1
* * * * Set p = cht.Pictures(mcPrefix & i)
* * Loop Until Err.Number 0
* * pic.Name = mcPrefix & i
End Sub

Sub DelWDpics()
Dim p As Picture
* * For Each p In cht.Pictures
* * * * If InStr(p.Name, mcPrefix) = 1 Then
* * * * * * p.Delete
* * * * End If
* * Next
End Sub

'''' end class clsChtEvents

Regards,
Peter T

Thanks, very much. Will reply shortly. (The PDF "pictures" I use are
actually drawings that architects converted from CAD)

On Aug 18, 1:36*pm, Pierre wrote:
On Aug 18, 12:17*pm, "Peter T" <peter_t@discussions wrote:





I wasn't concentrating when I gave those search terms, at best not enough
and at worst misleading. One thing I forgot to mention is you'd need to
relate your cursor co-ords to the zero point co-rod position on the sheet,
doable but more work.

I don't see any reason why you can't put your picture into a chart (don't
think you need all that PDF).
- Insert your picture onto a sheet
- create an empty chart and size a little larger than your picture
- cut your picture
- select the chart (ensure you get filled handles)
- paste the picture into the chart

Here's some code to get you started (normal module and class module as
indicated)
Assumes Sheet3 is empty but see GetWingDingPic() to change

Select your chart, and run SetChart()

With the chart selected press left button and Ctrl to paste a the wingding
picture (or Ctrl-Alt to delete them)

While the ref "mcChart" maintains scope you can deactivate and reactivate
the chart

'''' code in a normal module

Dim mcChart As clsChtEvents

Sub SetChart()
Dim cht As Chart
* * ' if will either reference the activechart
* * ' or the first embedded chart on the sheet

* * On Error Resume Next
* * Set cht = ActiveChart

* * If cht Is Nothing Then
* * * * Set cht = ActiveSheet.ChartObjects(1).Chart
* * End If

* * If Not cht Is Nothing Then
* * * * Set mcChart = New clsChtEvents
* * * * Set mcChart.cht = cht * *Else
* * * * MsgBox "no chart on sheet"
* * End If

End Sub

Sub MakeWingDingPic(Optional s As String = "J")
Dim cel As Range
Dim pic As Picture
Dim ws As Worksheet

* * ' an unused or hidden sheet
* * Set ws = Worksheets("Sheet3") ' << CHANGE if necessary

* * On Error Resume Next
* * Set pic = ws.Pictures("picWingDing_" & s)
* * On Error GoTo 0
* * If pic Is Nothing Then
* * * * ws.Pictures.Delete
* * * * Set cel = ws.Range("D4")
* * * * With cel
* * * * * * .Columns(1).Clear
* * * * * * .Font.Name = "WingDings"
* * * * * * .Font.Color = vbRed
* * * * * * '.Font.Bold = True
* * * * * * .Font.Size = 16
* * * * * * .Value = s
* * * * * * .HorizontalAlignment = xlCenter
* * * * * * .VerticalAlignment = xlCenter
* * * * * * .Columns(1).EntireColumn.AutoFit
* * * * * * .Interior.ColorIndex = xlNone
* * * * * * .CopyPicture Appearance:=xlScreen, Format:=xlPicture
* * * * End With

* * * * ws.Pictures.Paste

* * * * Set pic = ws.Pictures(ws.Pictures.Count)
* * * * With cel.Offset(, 2)
* * * * * * pic.Left = .Left
* * * * * * pic.Top = .Top
* * * * End With

* * * * pic.Name = "picWingDing_" & s
* * End If

* * pic.CopyPicture Appearance:=xlScreen, Format:=xlPicture

End Sub

'''' end normal module

''''' code in a class named "clsChtEvents"

Public WithEvents cht As Excel.Chart
Private mbFlag As Boolean

' typically points per pixel is 72/96
' but should confirm with API
Const PP As Single = 0.75
Const mcPrefix As String = "picWD_"

Private Sub cht_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
Dim pic As Picture
Const FF As Single = -3 * *' a fudge factor, experiment !

* * If Button = 1 And Shift = 2 Then * *'left button & Ctrl
* * * * MakeWingDingPic
* * * * cht.Pictures.Paste
* * * * Set pic = cht.Pictures(cht.Pictures.Count)
* * * * With pic
* * * * * * .Left = x * PP - .Width / 2 + FF
* * * * * * .Top = y * PP - .Height / 2 + FF
* * * * End With
* * * * NamePic pic
* * * * mbFlag = True
* * * * cht.ChartArea.Select * *' try and deselect the picture
* * ElseIf Shift = 6 Then ' Alt-Ctrl ' delete the pic's
* * * * DelWDpics
* * End If

End Sub

Private Sub cht_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x
As Long, ByVal y As Long)
* * If mbFlag Then
* * * * mbFlag = False
* * * * cht.ChartArea.Select
* * End If
End Sub

Sub NamePic(pic As Picture)
Dim p As Picture
Dim i As Long
* * On Error Resume Next
* * Do
* * * * i = i + 1
* * * * Set p = cht.Pictures(mcPrefix & i)
* * Loop Until Err.Number 0
* * pic.Name = mcPrefix & i
End Sub

Sub DelWDpics()
Dim p As Picture
* * For Each p In cht.Pictures
* * * * If InStr(p.Name, mcPrefix) = 1 Then
* * * * * * p.Delete
* * * * End If
* * Next
End Sub

'''' end class clsChtEvents

Regards,
Peter T

Thanks, very much. Will reply shortly. (The PDF "pictures" I use are
actually drawings that architects converted from CAD)- Hide quoted text -

- Show quoted text -

Peter,
I've done what you suggested but got stuck he ''''' code in a
class named "clsChtEvents"

I inserted a new Class "Class1" and tried to rename it to
"clsChtEvents" to no avail.
Obviously the sub SetChart() won't run.
Please pardon my ignorance!
Pierre