如何把固定内容自动复制到剪贴板，不需要按ctrl+c。

安若浅笑

需求：在实际工作中要把客户系统下单采购的订单号，料号和数量，下载出来后，我在编辑栏一条-条复制到WPS剪贴板后，再入系统，想请教大神们，在复制内容时，是否可以借助vba，点复制单元格订单号，料号，数量就自动复制到剪贴板，无需要按CTRL+C,谢谢！

baofa2

改传附件.zip (19.09 KB, 下载次数: 13)

2024-5-2 20:52 上传

点击文件名下载附件

安若浅笑

baofa2 发表于 2024-5-2 20:28

baofa2

安若浅笑 发表于 2024-5-2 20:51

不是那样用的，改进了，原楼改传附件了……

安若浅笑

baofa2 发表于 2024-5-2 20:28

您好！是一条一条自动点订单号，料号，数量时自动复制，代码是自动复制整行数据的，请问应该如何修改？

安若浅笑

baofa2 发表于 2024-5-2 20:28

首先很感谢你的回复，不好意思   想请你再帮个忙 ，附件文档是事整行复制，我想实现的是一条一条复制到剪贴板，请问能实现吗？

baofa2

安若浅笑 发表于 2024-5-3 08:53
首先很感谢你的回复，不好意思   想请你再帮个忙 ，附件文档是事整行复制，我想实现的是一条一条复制到剪 ...

1. Sub test0() '这个意思？若不对，你得模拟效果，截个图就行
   
2.   Dim ar, i As Long, j As Long
   
3.   ar = Range("A1").CurrentRegion
   
4.   For i = 1 To UBound(ar)
   
5.     For j = 2 To UBound(ar, 2)
   
6.       ar(i, 1) = ar(i, 1) & vbTab & ar(i, j)
   
7.     Next
   
8.   Next
   
9.   ar = WorksheetFunction.Transpose(WorksheetFunction.Index(ar, 0, 1))
   
10.   With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
11.     .SetText Join(ar, vbCrLf)
    
12.     .PutInClipboard
    
13.   End With
    
14.   '以上 将内容全部写入 粘贴板
    
15.   
    
16.   '以下 为导出文本文件 自行取舍
    
17.   Open ThisWorkbook.Path & "" & "导出.txt" For Output As #1
    
18.   Print #1, Join(ar, vbCrLf)
    
19.   Close #1
    
20. End Sub
    

复制代码

安若浅笑

baofa2 发表于 2024-5-3 09:50

安若浅笑

依次把订单号，料号，数量的内容复制到剪贴板

baofa2

安若浅笑 发表于 2024-5-3 11:21
依次把订单号，料号，数量的内容复制到剪贴板

Private Sub Worksheet_SelectionChange(ByVal Target As Range) '猜 再搞我也不会了
  Dim strContent As String, ran As Range, strClip As String
  With Range("A1").CurrentRegion
    Set ran = Intersect(.Offset(0), .Offset(1))
  End With
  If Not Intersect(Target, ran) Is Nothing Then
    If Target.Count = 1 Then
      strContent = Target.Value
      With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'        .GetFromClipboard
'        strClip = .GetText
        .SetText strContent
        .PutInClipboard
      End With
    End If
  End If
  Set ran = Nothing
End Sub