返回列表 上一主題 發帖

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

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

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

  36.     Else
  37.    
  38.     End If

  39. End Sub
複製代碼
2020-02-13_171752.png
2020-2-13 17:18

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



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

TOP

本帖最後由 Joforn 於 2020-10-28 08:43 編輯

呃,2020-2-13发的新帖,都10月了还在顶帖,好執著啊:D
世界那麼大,可我想去哪?

TOP

剛好今天不太忙,寫了一個效率高點了模組,可依照文件的相應后綴名生成指定格式的圖片文檔:
  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)
世界那麼大,可我想去哪?

TOP

回復 4# Joforn


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

TOP

        靜思自在 : 一個人不怕錯,就怕不改過,改過並不難。
返回列表 上一主題