复制文本后复制内容运行很慢

shenzhenyang

1. Sub 复制到新的文本()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. 
   
5.     Dim ws As Worksheet
   
6.    Set ws = ThisWorkbook.Sheets("Sheet1")
   
7.   fname = ActiveWorkbook.Name
   
8. 
   
9.     Dim cellValue As String
   
10.     cellValue = ws.Range("A1").Value
    
11.    
    
12.     Dim filePath As String
    
13.   filePath = "D:\Desktop\newfile.txt" ' 修改为你的文件路径和文件名
    
14.    
    
15.     Dim fnum As Integer
    
16.     fnum = FreeFile()
    
17.     Open filePath For Output As #fnum
    
18.     Print #fnum, cellValue
    
19.     Close #fnum
    
20.     Shell "notepad.exe " & filePath, vbNormalFocus
    
21. 
    
22.      ' 选择文本文件内容
    
23. '    SendKeys "^a", True ' 使用SendKeys选中全部内容
    
24. '    SendKeys "^c", True ' 复制到剪切板
    
25. '    SendKeys "%{F4}", True '关闭txt文件
    
26.    
    
27.    
    
28. 
    
29. Application.ScreenUpdating = True
    
30. 
    
31. End Sub
    

复制代码

上面代码是复制A1 单元格到新的文本，然后全选文本内容，复制剪切板，在全选文本内容复制到剪切板过程运行很慢，老师能怎么样才能运行更快。谢谢

shenzhenyang

'    SendKeys "^a", True ' 使用SendKeys选中全部内容
'    SendKeys "^c", True ' 复制到剪切板

现在用这个方法不是很理想，复制完都要等，想用其他方式可以复制的更快

chenhangrong

    我的版本是可以这样写入剪切板的
    wenben = [a1]
    Dim d As Object
    Set d = New DataObject
    d.SetText wenben
    d.PutInClipboard
    Set d = Nothing

shenzhenyang

chenhangrong 发表于 2024-8-26 13:57
我的版本是可以这样写入剪切板的
    wenben = [a1]
    Dim d As Object

可以复制，但有个问题就是我A1单元格实际是（A1：C37合并的单元格），这个单元格内容有时会多有时少，不是固定内容，按你这个代码直接复制到剪切板，下面会留一大截是空位，

如果经过文本后再复制内容，就是实际内容范围