EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Option Explicit
Function FolderExist(Path As String) As Boolean
On Error Resume Next
If Not Dir(Path, vbDirectory) = vbNullString Then
FolderExist = True
End If
On Error GoTo 0
End Function
Sub á¡data()
Dim rall As Range
Dim r As Range
With Sheets("Data")
Set rall = .Range("o2", .Range("o" & .Rows.Count).End(xlUp))
For Each r In rall
Sheets("Temp").Range("b4").Value = r.Value
Sheets("Temp").Copy after:=Sheets("Temp")
ActiveSheet.Name = Range("B4")
ActiveSheet.Move
If FolderExist("D:\Test\" & ActiveSheet.Range("B4").Value & "") Then
ChDir "D:\Test\" & Range("B4").Value & ""
ThisWorkbook.Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & ActiveSheet.Range("B4").Value & "\" & Range("B4").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveWorkbook.Close False
Else
On Error Resume Next
MkDir "D:\Test\"
MkDir "D:\Test\" & ActiveSheet.Range("B4").Value & ""
ChDir "D:\Test\" & ActiveSheet.Range("B4").Value & ""
ThisWorkbook.Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & ActiveSheet.Range("B4").Value & "\" & Range("B4").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveWorkbook.Close False
End If
Next r
End With
End Sub
Code: Select all
Sub á¡data()
Dim rall As Range, r As Range
Application.DisplayAlerts = False
With Sheets("Data")
Set rall = .Range("o2", .Range("o" & .Rows.Count).End(xlUp))
End With
For Each r In rall
With Sheets("Temp")
.Range("b4").Value = r.Value
.Copy after:=Sheets("Temp")
End With
With ActiveSheet
.Name = .Range("b4").Value
If FolderExist("D:\Test\" & .Name) Then
ChDir "D:\Test\" & .Name
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & .Name & "\" & _
.Name & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
On Error Resume Next
MkDir "D:\Test\"
MkDir "D:\Test\" & .Name
ChDir "D:\Test\" & .Name
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & .Name & "\" & _
.Name & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
.Delete
End With
Next r
Application.DisplayAlerts = True
End Sub