|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
猜一个- Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
- On Error Resume Next
- Dim d As DataObject, ar, i&, k&, rng As Range, s$
- Set d = New DataObject
- Set rng = Sheet1.Range("a2:f3")
- If Intersect(Selection, rng) Is Nothing Then
- Exit Sub
- Else
- ar = Selection.Value
- For i = 1 To UBound(ar)
- For k = 1 To UBound(ar, 2)
- If k = UBound(ar, 2) Then
- s = s & " " & ar(i, k) & Chr(10)
- Else
- s = s & " " & ar(i, k)
- End If
- Next
- Next
- d.SetText s
- d.PutInClipboard
- End If
- If Button = 2 Then
- With Application.CommandBars.Add("窗体菜单", msoBarPopup, , 1)
- With .Controls.Add(msoControlButton)
- .Caption = "粘贴"
- End With
- .ShowPopup
- End With
- Me.TextBox1.Text = s
- End If
- CommandBars("窗体菜单").Delete
- End Sub
复制代码 |
|