ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] Àx¦s®æ½d³ò½Æ»s&¥t¦s¦¨TIFÀÉ

[µo°Ý] Àx¦s®æ½d³ò½Æ»s&¥t¦s¦¨TIFÀÉ

½Ð±Ð¦U¦ì¤j¤j¡G
·Q¦bexcelªí®æAJ4Äæ¦ìÂùÀ»·Æ¹««á¡A
±NM2:V27³o­Ó½d³ò½Æ»s¦¨tifÀÉ(Àx¦s©ó®à­±)¡A
¦A¶}±Òoutlookµ{¦¡·s¶l¥ó«á
1.±N®à­±ªºtifÀÉ¥[¤Jªþ¥ó¤¤
2.¦A¥t¥~½Æ»sM2:V27½d³ò¦¨¹Ï¤ù¡A¶K¦b¶l¥ó¤º¤å¤¤
¥Ø«e¦³°ÝÀY¦p¤U¡G
1.M2:V27³o­Ó½d³ò½Æ»s¦¨tifÀÉ¡AÀx¦s¨ì®à­±«á¡AÀɮ׬OªÅ­ÈµL¸ê®Æ¡C
   ¦]¦ÑÁó­n¨D¡AÀÉ®×¥²¶·¬°tifÀÉ
2.½Æ»sM2:V27½d³ò¦¨¹Ï¤ù¡A¶K¦b¶l¥ó¤º¤å¤¤¡G
    ¦³¦b°Å¶Kï¡A¦ý¬O·s¶l¥ó®É¡A¤£·|¥X²{¦b¤º¤å¡A­n¦Û¤v¤â°Ê¦A«ö¶K¤W¤~¦³....
½Ð°Ý¥H¤Wµ{¦¡½X¸Ó¦p¦ó­×¥¿¡H
·PÁ¦U¦ì¤j¤j~~~~
  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.     '·s¼Wµ{¦¡½X¶}©l¡A§@¥Î¤¤Àx¦s®æ°±¦b­þ­Ó³¡ªù§O¡A´N³]©w¬°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)   '·s¼W¹Ïªí
  19.          .Chart.Paste                                                        '¶K¤W¹Ï¤ù
  20.          .Chart.Export Filename:="C:\Users\paz\Desktop\" & "Paz " & "Salary " & Range("B3") & "-" & Range("D3") & ".tif"    '¶×¥X¹Ï¤ù
  21.          
  22.          .Delete                                                             '§R°£¹Ïªí
  23.       End With
  24.    
  25.       Set temp = CreateObject("outlook.application")
  26.       Set newmail = temp.CreateItem(0)    '¨Ï¥Îoutlook?«Ø·s?¥ó
  27.          With newmail
  28.             .To = "[email protected]"          '¦¬¥ó¤H
  29.             .CC = ""         '§Û°e¤H
  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"      '²K¥[ªþ¥ó
  33.             .Display
  34.             '.Send
  35.          End With

  36.     Else
  37.    
  38.     End If

  39. End Sub
½Æ»s¥N½X

½Ð±Ð¦U¦ì¤j¤j¡G
·Q¦bexcelªí®æAJ4Äæ¦ìÂùÀ»·Æ¹««á¡A
±NM2:V27³o­Ó½d³ò½Æ»s¦¨tifÀÉ(Àx¦s©ó®à­±)¡A
¦A¶}±Òo ...
takeshilin88 µoªí©ó 2020-2-13 17:20



    ½Ð°Ý¦³°ª¤â¥i¥H«ü¾É¤@¤U¶Ü¡H

TOP

¥»©«³Ì«á¥Ñ Joforn ©ó 2020-10-28 08:43 ½s¿è

§c¡A2020-2-13发ªº·s©«¡A³£10¤ë¤F还¦b顶©«¡A¦n°õµÛ°Ú:D
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

­è¦n¤µ¤Ñ¤£¤Ó¦£¡A¼g¤F¤@­Ó®Ä²v°ªÂI¤F¼Ò²Õ¡A¥i¨Ì·Ó¤å¥óªº¬ÛÀ³¦Zºó¦W¥Í¦¨«ü©w®æ¦¡ªº¹Ï¤ù¤åÀÉ¡G
  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
½Æ»s¥N½X
SaveRangeToPictrue¨ç¼Æ¥N½X¹Lªø¡Aª½±µ©ñªþ¥ó¨½¤F¡C
SaveRangeToPictrue.zip (61.05 KB)
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

¦^´_ 4# Joforn


    ·PÁ¤j¤jªºÀ°¦£¡A
    ²×©ó¦³¤H²z§Ú¤F¡AÁÂÁÂ~~

TOP

        ÀR«ä¦Û¦b : ¦³®É·í«äµL®É­W¡A¦n¤Ñ­n¿n«B¨Ó³¡C
ªð¦^¦Cªí ¤W¤@¥DÃD