检查剪切板中是否有文本,没有文本在点击位置直接粘贴,有文本则在点击位置生成文本。
代码中大部分是别人发布的开源代码,如有定义名称一样的,那可能就是抄的你的代码
On Error GoTo out
Dim x As Double, y As Double, x2 As Double, y2 As Double
Dim Shift As Long
Dim box As Boolean
Dim B As Boolean
B = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorIntersectSingle)
Dim GetClipBoardString As String
Dim myData As New DataObject
myData.GetFromClipboard
GetClipBoardString = myData.GetText
Dim s2 As shape
Dim str As String
str = VBA.Replace(GetClipBoardString, vbNewLine, Chr(10))
str = VBA.Replace(GetClipBoardString, Chr(10), vbNewLine)
Set s2 = ActiveLayer.CreateArtisticText(0, 0, str)
s2.Text.Story.Font = "微软雅黑"
s2.CenterX = x
s2.CenterY = y
ActiveDocument.ClearSelection
Exit Sub
out:
ActiveLayer.Paste
ActiveSelectionRange.CenterX = x
ActiveSelectionRange.CenterY = y
Exit Sub