標題: [發問] 請問 Range 與 讀出篩選列數 ，如何改寫? [打印本頁]

---

作者: momo020608    時間: 2019-5-12 21:03     標題: 請問 Range 與 讀出篩選列數 ，如何改寫?

本帖最後由 momo020608 於 2019-5-12 21:04 編輯

請問各位大哥們
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

  Sheets("停牌列印").Visible = xlSheetVisible
     Sheets("停牌列印").Select
   ActiveWindow.SelectedSheets.PrintPreview

   
        Dim rgExp As Range
        Set rgExp = Range("轉發!A1:C25")   
         
'單純的範圍選取Range("轉發!A1:C25")，如果加入自動篩選後，該如何改寫 呢?         
就是 轉發的工作簿 A列 篩選，取消選取 空白 ，然後 選擇範圍，然後轉成 圖檔，發送電子郵件!
    ActiveSheet.Range("$A$1:$C$25").AutoFilter Field:=3, Criteria1:="<>"
                 
        ''' Copy range as picture onto Clipboard
        rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPrinter
        ''' Create an empty chart with exact size of range copied
        With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
        Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "myChart"
        .Activate
        End With
        ''' Paste into chart area, export to file, delete chart.
        ActiveChart.Paste
        ActiveSheet.ChartObjects("myChart").Chart.Export ThisWorkbook.Path & "\" & Range("A" & rgExp.Row).Value & ".jpg"
        ActiveSheet.ChartObjects("myChart").Delete
   
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .to = "[email protected]"
        .CC = ""
        .BCC = ""
   .Subject = "未繳款" & Date & WeekdayName(Weekday(Date)) & Time
        .Body = "未繳款" & Date & WeekdayName(Weekday(Date)) & Time
        '.Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        .Attachments.Add ("C:\Users\tcfv\Desktop\" & Range("A" & rgExp.Row).Value & ".jpg")
        .Send   'or use .Display
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
   
     Sheets("內帳管理").Select
End Sub

謝謝大家

---

作者: momo020608    時間: 2019-5-12 21:45

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm



   
        Dim rgExp As Range
        ActiveSheet.Range("輸出報表!A1:V4001").AutoFilter Field:=22, Criteria1:="<>"
  
        Set rgExp = Range("a1", ActiveSheet.Range("v65536").End(xlUp))
  

                 
        ''' Copy range as picture onto Clipboard
        rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPrinter
        ''' Create an empty chart with exact size of range copied
        With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
        Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "myChart"


改寫成功，但是還不能 指定 哪個工作簿 T_T

---

作者: momo020608    時間: 2019-5-12 22:10

本帖最後由 momo020608 於 2019-5-12 22:21 編輯

Sheets("輸出報表").Select
   
        Dim rgExp As Range
   
         Sheets("輸出報表").Range("輸出報表!A1:V4001").AutoFilter Field:=22, Criteria1:="<>"
  
        Set rgExp = Range("Sheets("輸出報表")a1", Sheets("輸出報表").Range("v65536").End(xlUp))

成功，但是還不能指定哪個工作簿T_T

就是 在 工作簿 報表A 時的畫面，指定另一 工作簿 "輸出報表" 剔除 空白，然後 選取 工作簿 "輸出報表" 篩選結果。

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)