[發問] 儲存格範圍複製&另存成TIF檔

takeshilin88

請教各位大大：
想在excel表格AJ4欄位雙擊滑鼠後，
將M2:V27這個範圍複製成tif檔(儲存於桌面)，
再開啟outlook程式新郵件後
1.將桌面的tif檔加入附件中
2.再另外複製M2:V27範圍成圖片，貼在郵件內文中
目前有問頭如下：
1.M2:V27這個範圍複製成tif檔，儲存到桌面後，檔案是空值無資料。
   因老闆要求，檔案必須為tif檔
2.複製M2:V27範圍成圖片，貼在郵件內文中：
    有在剪貼簿，但是新郵件時，不會出現在內文，要自己手動再按貼上才有....
請問以上程式碼該如何修正？
感謝各位大大~~~~

1. Sub Mail_Range()
   
2.     Dim Source As Range
   
3.     Dim temp As Object, newmail As Object, strg As String
   
4. 
   
5.         
   
6.     Set Source = Nothing
   
7.     On Error Resume Next
   
8.    
   
9.     '新增程式碼開始，作用中儲存格停在哪個部門別，就設定為Source
   
10.    
    
11.     If ActiveCell.Address = Cells(4, 14).Address Then
    
12.      Set Source = Range("M2:V27").SpecialCells(xlCellTypeVisible)
    
13.      ElseIf ActiveCell.Address = Cells(4, 36).Address Then
    
14.      Set Source = Range("AI2:AR27").SpecialCells(xlCellTypeVisible)
    
15.       
    
16.       Source.Copy
    
17.       
    
18.       Source.CopyPicture
    
19.       With ActiveSheet.ChartObjects.Add(1, 1, Source.Width, Source.Height)   '新增圖表
    
20.          .Chart.Paste                                                        '貼上圖片
    
21.          .Chart.Export Filename:="C:\Users\paz\Desktop\" & "Paz " & "Salary " & Range("B3") & "-" & Range("D3") & ".tif"    '匯出圖片
    
22.          
    
23.          .Delete                                                             '刪除圖表
    
24.       End With
    
25.    
    
26.       Set temp = CreateObject("outlook.application")
    
27.       Set newmail = temp.CreateItem(0)    '使用outlook?建新?件
    
28.          With newmail
    
29.             .To = "paz@test.com.tw"          '收件人
    
30.             .CC = ""         '抄送人
    
31.             .Subject = "Salary " & Range("B3") & "-" & Range("D3")                    '?件??
    
32.             .Body = Selection.PasteSpecial
    
33.             .Attachments.Add "C:\Users\paz\Desktop\" & "Paz " & "Salary " & Range("B3") & "-" & Range("D3") & ".tif"      '添加附件
    
34.             .Display
    
35.             '.Send
    
36.          End With
    
37. 
    
38.     Else
    
39.    
    
40.     End If
    
41. 
    
42. End Sub

複製代碼

下載 (25.11 KB)

2020-2-13 17:18

takeshilin88

請教各位大大：
想在excel表格AJ4欄位雙擊滑鼠後，
將M2:V27這個範圍複製成tif檔(儲存於桌面)，
再開啟o ...
takeshilin88 發表於 2020-2-13 17:20

    請問有高手可以指導一下嗎？

Joforn

呃，2020-2-13发的新帖，都10月了还在顶帖，好執著啊:D

Joforn

剛好今天不太忙，寫了一個效率高點了模組，可依照文件的相應后綴名生成指定格式的圖片文檔：

1. Sub Test()
   
2.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.BMP")
   
3.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.jpg")
   
4.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.EMF")
   
5.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.PNG")
   
6.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.GIF")
   
7.   Debug.Print SaveRangeToPictrue(Range("M2:V27"), ThisWorkbook.Path & Application.PathSeparator & "Test.TIF")
   
8. End Sub

複製代碼

SaveRangeToPictrue函數代碼過長，直接放附件里了。
SaveRangeToPictrue.zip (61.05 KB)

SaveRangeToPictrue代碼附件
下載次數: 13

2020-10-28 10:25

takeshilin88

回復 4# Joforn


    感謝大大的幫忙，
    終於有人理我了，謝謝~~