VBA中用户窗体截图

哈喽哈哈1

各位老师求助一下，有没有办法通过用户窗体中的命令按钮，对已查询的用户窗体信息进行截图并保存在ThisWorkbook的途径中。

3190496160

查询到的结果，用代码直接导出不就行了吗

哈喽哈哈1

3190496160 发表于 2024-9-26 08:27
查询到的结果，用代码直接导出不就行了吗

1. Private Sub UserForm_Initialize()
   
2.     Dim i As Integer
   
3.     For i = 1 To 43
   
4.         Me.Controls("TextBox" & i).BackColor = vbButtonFace
   
5.     Next i
   
6. End Sub
   
7. 
   
8. Private Sub CommandButton1_Click()
   
9. 
   
10.     Dim rng48 As Range, rng46 As Range
    
11.    
    
12.     Dim i As Integer
    
13.    
    
14.     Dim searchValue48 As String, searchValue46 As String
    
15.    
    
16.     Dim folderPath As String, fileName As String, photoPath As String
    
17. 
    
18.     ' 获取TextBox48和TextBox46的值
    
19.    
    
20.     searchValue48 = Trim(UserForm1.TextBox48.Text)
    
21.    
    
22.     searchValue46 = Trim(UserForm1.TextBox46.Text)
    
23. 
    
24.     ' 检查搜索值是否为空
    
25.    
    
26.     If searchValue48 = "" Or searchValue46 = "" Or ComboBox1 = "" Then
    
27.    
    
28.         MsgBox "请输入搜索值！", vbExclamation
    
29.         
    
30.         Exit Sub
    
31.     End If
    
32. 
    
33.     ' 查找TextBox48对应的信息并填充到TextBox中
    
34.    
    
35.     Set rng48 = Sheet2.Range("A:A").Find(searchValue48, LookIn:=xlValues, LookAt:=xlWhole)
    
36.    
    
37.     If rng48 Is Nothing Then
    
38.    
    
39.         MsgBox "你搜索的工艺不存在（新工艺编号）", vbInformation
    
40.         
    
41.         Exit Sub
    
42.         
    
43.     End If
    
44. 
    
45.     ' 填充数据到文本框
    
46.     For i = 1 To 44
    
47.    
    
48.         Me.Controls("TextBox" & i).Text = rng48.Offset(0, i).Value
    
49.         Me.Controls("TextBox" & i).BackColor = vbButtonFace ' 重置背景色
    
50.         Me.Controls("TextBox" & i).ForeColor = vbBlue ' 重置前景色
    
51.         
    
52.     Next i
    
53. 
    
54.     ' 查找TextBox46对应的信息并对比
    
55.    
    
56.     Set rng46 = Sheet2.Range("A:A").Find(searchValue46, LookIn:=xlValues, LookAt:=xlWhole)
    
57.     If rng46 Is Nothing Then
    
58.    
    
59.         MsgBox "你搜索的工艺不存在（现有工艺编号）", vbInformation
    
60.         
    
61.         Exit Sub
    
62.         
    
63.     End If
    
64. 
    
65.     ' 对比TextBox48和TextBox46的信息，并设置背景色
    
66.     For i = 1 To 43
    
67.    
    
68.         If rng46.Offset(0, i).Value <> rng48.Offset(0, i).Value Then
    
69.         
    
70.             Me.Controls("TextBox" & i).ForeColor = vbRed
    
71.             
    
72.         End If
    
73.     Next i
    
74. 
    
75. folderPath = ThisWorkbook.Path & "\照片" ' 替换为你的搜索值
    
76. 
    
77. ' 首先尝试查找.jpg文件
    
78. fileName = Dir(folderPath & "" & searchValue48 & ".JPG")
    
79. 
    
80. ' 如果没有找到.jpg文件，则尝试查找.png文件
    
81. If fileName = "" Then
    
82.     fileName = Dir(folderPath & "" & searchValue48 & ".PNG")
    
83. End If
    
84. 
    
85. ' 如果找到了文件，则加载图片
    
86. If fileName <> "" Then
    
87.     photoPath = folderPath & "" & fileName
    
88.     UserForm1.Image1.Picture = LoadPicture(photoPath)
    
89.     UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
    
90. Else
    
91.     UserForm1.Image1.Picture = Nothing
    
92. End If
    
93. 
    
94.     searchValue46 = Me.TextBox46.Value
    
95.    
    
96.     searchValue48 = Me.TextBox48.Value
    
97.    
    
98.     Set ws = ThisWorkbook.Sheets("查询记录")
    
99.    
    
100.     lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
     
101.    
     
102.    ' 记录查询内容
     
103.     ws.Cells(lastRow, 1).Value = Me.ComboBox1.Value
     
104.    
     
105.     ws.Cells(lastRow, 2).Value = searchValue46
     
106.    
     
107.     ws.Cells(lastRow, 3).Value = searchValue48
     
108.    
     
109.     ws.Cells(lastRow, 4).Value = Now
     
110.    
     
111. End Sub

复制代码

老师，这是我写的代码，我的需求是查询出来的窗体信息进行截图放到一个文件夹内，到时候会把这些图片在电视屏幕上进行滚动播放

哈喽哈哈1

具体代码在3楼