[µo°Ý] ¦h±i¤u§@ªí¸ê®Æ¾ã¦X©óÁ`ªí

missbb

·Q±NSUMMARY¥H¥~ªº¨C¤@±iWORKSHEET¤ºªºB4ªº¨C¤@­Ó½s¸¹, ¦bSUMMARYªºA2°_ÂШî30¦¸, ¤U¦C¼gªº¤Ó¤£¨¬¤F, ¥i¥H¨ó§U¶Ü? ª¦¤å«Ü¤[¤]·Q¤£³q:'(

Sub SummurizeSheets()
    Dim ws As Worksheet
    Dim myrange As Range
   
    Application.ScreenUpdating = False
    Sheets("Summary").Activate

    For Each ws In Worksheets
        If ws.Name <> "Summary" Then
            Sheets("summary").myrange("A2:A30").End(xlUp) = ws.Range("B4:B3").Copy
            ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
        End If
    Next ws
End Sub

missbb

¦^´_ 12# missbb

§Ú¥i¥H±N¤u§@ªíATTENDANCE REPORT V3:AZ3ªº¤é´ÁÂà¸m¨ì¤u§@ªíLEAVE SUMMAy, ¦ýv3:AZ3¦p¦ó¥Hcopy 30¦¸¹ïÀ³¨C­Ó­û¤u, ¦]­û¤u¤£­û1­Ó?

¦p¦ó¥i¥H±N¨C­Ó­û¤uªºATTENDANCE REPORT¤ºªº"°²´Á/¨Ò°²/³Æµù"¦C¤ºªº³Ò©Î¨Ò«ö­û¤u¤Î¤é´Á°t¸m©óleave summaryªºdÄæ©O? ¥Î¨ç¼Æ(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)))¬O¥i¥H°µ¨ì, ©Î¦p¦ó±N¨ç¼Æ¥[¤Jvba¤º?

¥¼§¹ªºvba:
Sheets("attendance report").Range("v3:az3").Copy
Sheets("leave summary").Range("c2").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True
   
·P¿E! Âà¸m¨ç¼Æ.rar (285.08 KB)

¤U¸ü¦¸¼Æ: 7

2015-8-8 23:23

missbb

¦^´_ 11# GBKEE

Åý§Ú¸Õ¤@¤U, ·P¿E!:'(

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) = ""         '¨ú±o©Ò¦³¤£­«½Æ¤À©±
   
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" '¦P¦WÀɮקR°£
    
12.             .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    
13.             "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    
14.             IgnorePrintAreas:=False, OpenAfterPublish:=False  '¥t¦s¦¨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 ¥\¯àªí«ü¥O: ¤u¨ã->³]©w¤Þ¥Î¶µ¥Ø ·s¼W -> [Microsoft CDO for Windows 2000 Library]
    
23.     '¥i Google   CreateObject("CDO.Message") ¤F¸Ñ
    
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 ¶Ç°e¶l¥ó
    
30.             .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    
31.             .Update
    
32.         End With
    
33.         .From = "±H¥óªÌ@pchome.com"           '±H¥óªÌ¡]ºô°ì¥²¶·¦s¦b¡^
    
34.         .To = "¦¬¥óªÌ@gmail.com"
    
35.         .Subject = "CreateObjectCDO.Message CDO¶l¥ó´ú¸Õ"    '¶l¥ó¥D¦®
    
36.         .HTMLBody = "¶l¥ó¥»¤å"   'HTML¶l¥ó¤º¤å
    
37.         .AddAttachment xFile   'ªþÀÉ
    
38.         .Send
    
39.     End With
    
40. End Sub

½Æ»s¥N½X

missbb

¦^´_ 5# GBKEE

¦­«eµ¹§Úªº«ü¾É, ²{¨D±Ð¦p»Ý¨C­ÓPDF§¡µo¥X¤@­Ó¹q¶l, ¤U¦Cªºµ{¦¡­n¦p¦ó§ó§ï©O? ¨D½ç±Ð!

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
With Worksheets("attendance report")
For Each a In .Range(.[E4], .[E4].End(xlDown))
  d(a.Value) = ""         '¨ú±o©Ò¦³¤£­«½Æ¤À©±
Next
F = InputBox("Enter your month")

For Each ky In d.keys
     .Range("B4").AutoFilter Field:=4, Criteria1:=ky
     If Dir("C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf") <> "" Then Kill "C:\Users\mariasfy\Desktop\" & ky & "_" & F & "201507.pdf" '¦P¦WÀɮקR°£
     .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False  '¥t¦s¦¨PDFÀÉ®×

Next

Dim Mail_Object, Mail_Single As Variant
Email_Subject = "ªù¥«¥X¶Ô³ø§i"
Email_Cc = ""
Email_Bcc = ""
Email_Body = "ªù¥«¥X¶Ô³ø§i, ½Ð¦^ÂÐ"

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 ("C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf")
.Display
'.send
End With

If .FilterMode = True Then .ShowAllData 'Åã¥Ü©Ò¦³¸ê®Æ

End With

End Sub

missbb

¦^´_ 11# lpk187

¦hÁ§A¤£Ãã³Ò­W¦aµ¹§Ú¸Ñµª, ÁöµM¾Ç²ß¤¤, ·|Ä~Äò§V¤O:L

lpk187

¦^´_ 10# missbb

§Ú¦b9¼Ó´N¦³¸ÑÄÀµ¹§A¤F¡A³æ¤@¦³³æ¤@ªº°µªk¡A½d³ò¦³½d³òªº°µªk¡A³æ¤@¤£¤@©w¯à®M¥Î¦b½d³ò
    Sub move()
For Each ws In Worksheets
    ll = ws.Name
        If ws.Name <> "summary" Then
            ½d³ò¼Æ¶q = ws.Range("B4", ws.Range("B65536").End(xlUp).Address).Count
            ½d³ò°}¦C¤º®e = ws.Range("B4", ws.Range("B65536").End(xlUp).Address) '¨Ï¨ä¦¨¬°°}¦C
            For Each Rng In ½d³ò°}¦C¤º®e
                Sheets("summary").Range("A65536").End(xlUp).Offset(1).Resize(30) = Rng
            Next
        End If
    Next
End Sub

missbb

¦^´_ 9# lpk187

¹ï¤£°_, «ö§Aªº¤èªk¥u¯à±N¨C­Ó¤u§@ªíªºB4¤º®eÅã¥Ü1¦¸.

¤U¸ü (5.4 KB)

2015-8-2 18:03

¦p§ï¬°RESIZE 30, «h¥X°t#NA

¤U¸ü (6.57 KB)

2015-8-2 18:03

°ÝÃD¦b¨º©O?:dizzy:

lpk187

¦^´_ 8# missbb


    ·í½Æ»sªº¨Ó·½¥u¦³¤@­ÓÀx¦s®æ¡A¤º¦s¥u·|§â³o­ÓÀx¦s®æªº¤º®e·í¦¨¤@­Ó¦r¦ê¡A©Ò¥H¥¦·|§â³o­Ó¦r¦ê¤À¦¨N­Ó¦r¦ê¤À§O½Æ»s¨ì¥ØªºªºÀx¦s®æ¡A
¦ý­Y¦³¶W¹L¤@­Ó¥H¤Wªº¨Ó·½Àx¦s®æ¡A«h·|¦¨¬°°}¦C¡A©Ò¥H¥²¶·¦¨¬°
     ¥ØªºÀx¦s®æªº½d³ò¼Æ¶q(Count)=¨Ó·½Àx¦s®æªº½d³ò¼Æ¶q(Count)

1. Sub move()
   
2. For Each ws In Worksheets
   
3.     ll = ws.Name
   
4.         If ws.Name <> "summary" Then
   
5.             ½d³ò¼Æ¶q = ws.Range("B4", ws.Range("B65536").End(xlUp).Address).Count
   
6.             ½d³ò°}¦C¤º®e = ws.Range("B4", ws.Range("B65536").End(xlUp).Address)'¨Ï¨ä¦¨¬°°}¦C
   
7.             Sheets("summary").Range("A65536").End(xlUp).Offset(1).Resize(½d³ò¼Æ¶q) = ½d³ò°}¦C¤º®e
   
8.         End If
   
9.     Next
   
10. End Sub

½Æ»s¥N½X

missbb

¦^´_ 7# GBKEE

CLEAR CONTENT¦¨¥\¤F, ¦ý¦]WORKBOOK¤º¦³¶W¹L1±iSHEET, ¨C±iSHEET§¡¥ÑB4°_¦³¤£¦Pªø«×ªº¼Æ­È, ²{¦b¬O¨ú¤F¨C¤u§@ªíªºB4¼Æ­È, §Ú§ï¤F¤U¦C, «o¤S¥u¨ú¤F¨C¤u§@ªíªº³Ì«á¤@¦C¼Æ­È, ½Ð«ü¾É?

Sheets("summary").Range("A65536").End(xlUp).Offset(1).Resize(30) = VBA.rar (26.49 KB)

¤U¸ü¦¸¼Æ: 3

2015-8-2 15:13