[µo°Ý] EXCEL ¿z¿ï«áªþ¥[¹q¶l

missbb

¦U¦ì, §Ú¦³¤@­ÓEXCEL VBA CODE, ¬O¦¨¥\±NEXCEL¿z¿ï«áÂରPDFªþ¥[¹q¶l. ²{¦b¤£·QÂàPDF¦Óª½«ö¥ÎEXCELªþ¥[¹q¶l. ¨D«ü±Ð.[code]Sub input_pdf_6()
' Sub finalpdf_7()
'send excel , one excel for one shop only


    Dim xPath As String
    xPath = Application.ActiveWorkbook.Path
    Set D = CreateObject("Scripting.Dictionary")

    With Worksheets("attendance report")
        For Each A In .Range(.[d6], .[d6].End(xlDown))
            D(A.Value) = ""         'no repeat shop
        Next

            f = InputBox("input report YYMM, EG : 201508")
                If f = "" Then Exit Sub
   
        
Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$5"
        .PrintTitleColumns = ""
    End With
   
        
        For Each ky In D.KEYS
             .Range("d6").AutoFilter Field:=4, Criteria1:=ky
     
        If Dir(xPath & "\" & ky & "_" & f & ".pdf") <> "" Then Kill xPath & "\" & ky & "_" & f & ".xlxs" '¦P¦WÀɮקR°£
        .ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            xPath & "\" & ky & "_" & f & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False


    Dim Mail_Object, Mail_Single As Variant
    Dim contact As String
        contact = "[email protected]"
            Email_Subject = ky & "_" & f & "_" & "monthly report checking"
            Email_Cc = ""
            Email_Bcc = ""
            Email_Body = "" & Worksheets("email message").Range("b2")


        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(o)

        With Mail_Single
            .Subject = Email_Subject
            .to = Email_Send_To
            .Cc = Email_Cc
            .Bcc = Email_Bcc
            .Body = Email_Body
            .Attachments.Add (xPath & "\" & ky & "_" & f & ".xlxs")
            .Display
        

        End With
             Next
        If .FilterMode = True Then .ShowAllData

    End With

End Sub


EXCLE¹q¶l.zip (23.42 KB)

¤U¸ü¦¸¼Æ: 5

2020-4-27 19:43

GBKEE

¦^´_ 1# missbb


°Ñ¦Ò     http://forum.twbts.com/thread-22512-1-1.html

1. fds = Application.GetOpenFilename("Excel Files (*.xlsm;*.xlsx), *.xlsm;*.xlsx", , , , True)
   
2.          If IsArray(fds) Then
   
3.             For i = 1 To UBound(fds)
   
4.             .Attachments.Add fds(i)
   
5.            Next
   
6.         End If

½Æ»s¥N½X