Code:
Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Const GHND = &H42
Private Const CF_TEXT = 1
Sub clipboard_1()
Call string_to_clipboard("Just check it, if it worked....")
End Sub
Private Sub string_to_clipboard(str As String)
Dim hGlobalMemory As Long
hGlobalMemory = GlobalAlloc(GHND, Len(str) + 1)
Dim lpGlobalMemory As Long
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, str)
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Couldn't GlobalUnlock"
End If
If OpenClipboard(0&) = 0 Then
MsgBox "Couldn't open Clipboard"
Exit Sub
End If
Dim dummy As Long
dummy = EmptyClipboard()
Dim hClipMemory As Long
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
If CloseClipboard() = 0 Then
MsgBox "Clipboard could not be closed"
End If
End Sub
Sub nodeCoord()
Dim s As Shape
Dim n As Node
Dim x As String, y As String
Dim xy As String
'Dim rVal As Long
'ActiveDocument.Unit = cdrMillimeter
If ActiveSelection.Shapes.Count = 0 Then
MsgBox "Please select a single curve shape"
Exit Sub
End If
Set s = ActiveShape
For Each n In s.Curve.Nodes
x = Round(n.PositionX, 3) & ", "
y = Round(n.PositionY, 3) & ", "
xy = xy + x & y
'rVal = MsgBox(xy, vbOKCancel)
'If rVal = 2 Then Exit Sub
Next n
string_to_clipboard (xy)
MsgBox "The string csv is now in your clipboard. You can paste into any document."
End Sub
MyAccount
