帖子: 78
主題: 30
精華: 0
積分: 109
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2014-5-15
最後登錄: 2018-9-16

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2015-6-7 13:28 | 只看該作者

請問用vba截圖非篩選狀態可以擷取但篩選後不能請問該怎麼改呢

大大
請問如果
我是排序這都還可寫vba截圖

如果是數值篩選後
如果需要取23檔標的跟到w列

請問該怎麼修正下面這一段呢

Dim Rng As Range
Set Rng = Range("A1:v35") '指定的範圍
'Set Rng = Selection    '滑鼠選定的範圍
Rng.CopyPicture
With ActiveSheet.ChartObjects.Add(1, 1, Rng.Width, Rng.Height)  '新增圖表
      .Chart.Paste                                        '貼上圖片
      .Chart.Export FileName:="d:\" & Format(Date, "yyyy-mm-dd") & "合計買賣比buy" & ".png"

   ' .Chart.Export FileName = "D:\" & Format(Date, "yyyy-mm-dd") & ".png"    '匯出圖片"

      .Delete                                              '刪除圖表
End With
Selection.AutoFilter

2015-6-7 下午 01-24-01.png (114.9 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2015-6-7 14:44 | 只看該作者

回復 1# vavashop

試試看

Option Explicit
Sub EX()
Dim Sh As Worksheet, Rng As Range
Set Rng = ActiveSheet.Range("A1:v35") '指定的範圍
Set Sh = Sheets.Add '新增的工作表
Rng.AutoFilter 1, "A" '*** 請修改你的自動篩選條件 ***
With Sh '新增的工作表
Rng.Copy .[A1] '複製已自動篩選的範圍
.UsedRange.CopyPicture '使用範圍儲存格的螢幕影像複製到剪貼簿
With .ChartObjects.Add(1, 1, .UsedRange.Width, .UsedRange.Height) '新增圖表
.Chart.Paste '貼上圖片
.Chart.Export Filename:="d:\" & Format(Date, "yyyy-mm-dd") & "合計買賣比buy" & ".png"
End With
'DisplayAlerts 屬性特定如果巨集在執行時 Microsoft Excel 顯示特定的警告和訊息則為 True。讀/寫 Boolean。
Application.DisplayAlerts = False
.Delete '刪除'新增的工作表
Application.DisplayAlerts = True
End With
Rng.AutoFilter
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

vavashop

中學生 Rank: 2

帖子: 78
主題: 30
精華: 0
積分: 109
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2014-5-15
最後登錄: 2018-9-16

論壇贊助勳章

3^#

發表於 2015-6-7 20:33 | 只看該作者

Rng.AutoFilter 1, "A" '*** 請修改你的自動篩選條件 ***
With Sh '新增的工作表
Rng.Copy .[A1] '複製已自動篩選的範圍

大大是改這個??

我需要的是橫向到V
列往下抓35個

拍出來的畫面是圖片這樣有點怪
是哪邊錯了嗎?

2015-06-07合計買賣比buy.png (20.27 KB)

TOP

vavashop

中學生 Rank: 2

帖子: 78
主題: 30
精華: 0
積分: 109
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2014-5-15
最後登錄: 2018-9-16

論壇贊助勳章

4^#

發表於 2015-6-7 20:46 | 只看該作者

大大我用好了感謝

請問如果我要固定抓這網頁的
EXCEL 達人寶典的檔案到我的 EXCEL該怎麼抓我想把他的檔名當成分頁的名稱即可
我有想過就是自己在A1增加一個欄位為日期然後把它變成超連結在抓下來之後再改分頁名稱
不知道大大有比較建議的方式嗎?

http://iwarrant.capital.com.tw/wdataV2/canonical/capital/%E6%AC%8A%E8%AD%89%E9%81%94%E4%BA%BA%E5%AF%B6%E5%85%B82015-06-05.xls

http://iwarrant.capital.com.tw/warrants/wCanonical.aspx

TOP

vavashop

中學生 Rank: 2

帖子: 78
主題: 30
精華: 0
積分: 109
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
註冊時間: 2014-5-15
最後登錄: 2018-9-16

論壇贊助勳章

5^#

發表於 2015-6-7 23:45 | 只看該作者

Sub aw2e()

Dim y, m, d, param As String ' 宣告 y, m, d, param 為字串變數

y = Sheets("上市").Range("B2") ' 西元年
m = Format(Sheets("上市").Range("B3"), "00") ' 月，使用Format函數強制十位數補0
d = Format(Sheets("上市").Range("B4"), "00") ' 日，使用Format函數強制十位數補0
param = (y - 1911) & "/" & m & "/" & d ' 民國年/月/日

Range("A1").Select
ActiveCell.FormulaR1C1 = _
   "http://iwarrant.capital.com.tw/wdataV2/canonical/capital/%E6%AC%8A%E8%AD%89%E9%81%94%E4%BA%BA%E5%AF%B6%E5%85%B8" & y & "-" & m & "-" & d & ".xls"

'下方開始點選a1網址列
'下載後複製貼回    Sheets("達人寶典暫存").Select
'
'
   Range("A1").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Cells.Select

Range("A1").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Selection.Copy
Windows("2012-2015月營收(總資料庫2)new大修改20150511.xlsm").Activate
Sheets("達人寶典暫存").Select
Cells.Select
ActiveSheet.Paste

Windows("權證達人寶典" & y & "-" & m & "-" & d & " .xls").Activate
ActiveWindow.Close
Application.DisplayAlerts = False  '關閉警示視窗

請問一下這一段    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 會卡住

請問是不是哪邊出了問題??

請大大指點一下

TOP