GBKEE

回復 11# missbb

試試看

1. Option Explicit
   
2. Sub ex()
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Worksheets("attendance report")
   
5.         For Each a In .Range(.[E4], .[E4].End(xlDown))
   
6.             d(a.Value) = ""         '取得所有不重複分店
   
7.         Next
   
8.         F = InputBox("Enter your month")
   
9.         For Each ky In d.keys
   
10.             .Range("B4").AutoFilter Field:=4, Criteria1:=ky
    
11.             If Dir("C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf") <> "" Then Kill "C:\Users\mariasfy\Desktop\" & ky & "_" & F & "201507.pdf" '同名檔案刪除
    
12.             .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    
13.             "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    
14.             IgnorePrintAreas:=False, OpenAfterPublish:=False  '另存成PDF檔案
    
15.             '************************************************************
    
16.             SendMail "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf"
    
17.             '************************************************************
    
18.         Next
    
19.     End With
    
20. End Sub
    
21. Sub SendMail(xFile As String)
    
22.     'VBA 功能表指令: 工具->設定引用項目 新增 -> [Microsoft CDO for Windows 2000 Library]
    
23.     '可 Google   CreateObject("CDO.Message") 了解
    
24.     Dim objEmail As Object
    
25.     Set objEmail = CreateObject("CDO.Message")      '建立 CDO 物件
    
26.     With objEmail
    
27.         With .Configuration.Fields
    
28.             .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    
29.             .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "msa.hinet.net"              '使用 msa.hinet.net 傳送郵件
    
30.             .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    
31.             .Update
    
32.         End With
    
33.         .From = "寄件者@pchome.com"           '寄件者（網域必須存在）
    
34.         .To = "收件者@gmail.com"
    
35.         .Subject = "CreateObjectCDO.Message CDO郵件測試"    '郵件主旨
    
36.         .HTMLBody = "郵件本文"   'HTML郵件內文
    
37.         .AddAttachment xFile   '附檔
    
38.         .Send
    
39.     End With
    
40. End Sub

複製代碼

missbb

回復 11# GBKEE

讓我試一下, 感激!:'(

missbb

回復 12# missbb

我可以將工作表ATTENDANCE REPORT V3:AZ3的日期轉置到工作表LEAVE SUMMAy, 但v3:AZ3如何以copy 30次對應每個員工, 因員工不員1個?

如何可以將每個員工的ATTENDANCE REPORT內的"假期/例假/備註"列內的勞或例按員工及日期配置於leave summary的d欄呢? 用函數(IF(ISERROR(INDEX('ATTENDANCE REPORT'!$1:$1048576,MATCH($A$2,'ATTENDANCE REPORT'!$M:$M,0),MATCH(DAY($C2),'ATTENDANCE REPORT'!$3:$3,0))),"",INDEX('ATTENDANCE REPORT'!$1:$1048576,MATCH($A$2,'ATTENDANCE REPORT'!$M:$M,0),MATCH(DAY($C2),'ATTENDANCE REPORT'!$3:$3,0)))是可以做到, 或如何將函數加入vba內?

未完的vba:
Sheets("attendance report").Range("v3:az3").Copy
Sheets("leave summary").Range("c2").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True
   
感激! 轉置函數.rar (285.08 KB)

下載次數: 7

2015-8-8 23:23