作者viskboy (qa)
看板Office
标题[问题] excel vba 筛选後资料汇出图片
时间Sat Mar 23 12:37:58 2024
(若是和其他不同软体互动之问题 请记得一并填写)
软体:excel
版本:2016
目前依照搜寻使用以下程式执行时，汇出的图片是空白没有对应的资料；但是使用F8一步一步执行汇出的图片就正常。
请问有甚麽地方需要修改吗？谢谢
Sub 自动筛选截图程式()
Set NAMESHEET = Sheets("工作表2")
Set CSHEET = Sheets("工作表1")
Crow = NAMESHEET.Range("A" & Cells.Rows.Count).End(xlUp).Row
'计算第A栏有几行(列)，以利後面使用
For j = 1 To Crow
'从哪行起始
Name = NAMESHEET.Cells(j, 1)
'工作表2的A栏
CSHEET.Rows(1).AutoFilter 1, Name '*** 请修改你的自动筛选条件 ***
'Name为变数
'Rows跟Autofilter都是在指筛选器的选取位置
CSHEET.UsedRange.CopyPicture '使用范围储存格的萤幕影像复制到剪贴簿
With ActiveSheet
With .ChartObjects.Add(1, 1, .UsedRange.Width, .UsedRange.Height)
.Chart.Paste '贴上 图片
.Chart.Export Filename:="D:\" & "TEST\" & Name & ".jpg"
'需修改路径(图片存档位置)
.Chart.Parent.Delete
End With
.Rows(1).AutoFilter
End With
Next j
Application.ScreenUpdating = True
MsgBox "跑好了", vbOKOnly
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 114.137.239.230 (台湾)
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1711168682.A.9B4.html
1F：→ waiter337: past後面要加上 appliaction.wait now+timevalue(00:00 03/23 12:49
2F：→ waiter337: :01) 电脑太慢可以改等待2秒 03/23 12:49
3F：→ waiter337: 更正 past下面 03/23 12:49
4F：→ waiter337: paste下面 03/23 12:49
5F：→ waiter337: 贴图会lag 但这里没有异步能操作 只能硬等两秒 03/23 12:50
7F：→ viskboy: 感谢回覆，目前有增加时间执行後状况一样。 03/23 15:31
8F：→ viskboy: 逐步执行到paste时显示空白图示，往下执行图片位置储存才 03/23 15:31
9F：→ viskboy: 有跑出资料图片。 03/23 15:31
10F：→ rafaiero: 我有类似的问题，我解决的方式是用do回圈，直到有资料 03/23 17:04
11F：→ rafaiero: 为止才往下执行非常可行唷 03/23 17:04
12F：→ viskboy: 抱歉，本身是vba新手。请问Do回圈要怎麽写及位置，谢谢您 03/23 17:16
13F：→ viskboy: 的回覆。还是有范例可以参考，十分感谢您 03/23 17:16
14F：→ rafaiero: do 03/23 17:43
15F：→ rafaiero: “贴上的区间的程式” 03/23 17:43
16F：→ rafaiero: Loop until ChartObjects.Count > 0 03/23 17:43
17F：→ viskboy: 感谢您的回覆。 03/23 23:09
18F：→ viskboy: 问题已解决。.Paste上面插入一句.Parent.Select就能正常 03/24 12:27