Board logo

標題: [發問] 儲存格範圍複製&另存成TIF檔 [打印本頁]
作者: takeshilin88    時間: 2020-2-13 17:20     標題: 儲存格範圍複製&另存成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

  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 = "[email protected]"          '收件人
  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

  38.     Else
  39.    
  40.     End If

  42. End Sub
複製代碼
[attach]31708[/attach]
作者: takeshilin88    時間: 2020-10-14 15:32

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



    請問有高手可以指導一下嗎？
作者: Joforn    時間: 2020-10-28 08:42

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

呃，2020-2-13发的新帖，都10月了还在顶帖，好執著啊:D
作者: Joforn    時間: 2020-10-28 10:30

剛好今天不太忙，寫了一個效率高點了模組，可依照文件的相應后綴名生成指定格式的圖片文檔：
  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函數代碼過長，直接放附件里了。
[attach]32657[/attach]
作者: takeshilin88    時間: 2020-10-28 11:22

回復 4# Joforn


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



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