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
Sub test()
Dim i As Long
Dim r As Range
On Error Resume Next
With Worksheets("Data")
Set r = .Range("E2", .Range("E65536").End(xlUp))
End With
For i = 1 To r.Count
If i > 1 Then
Sheets("Data").Select
Cells((2 + i), 5).Select
Selection.Copy
Sheets("Temp").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Temp").Select
Sheets("Temp").Copy After:=Sheets(2)
ActiveSheet.Name = Range("B4")
Sheets("Data").Select
End If
Sheets("Data").Select
Range("E2").Select
Selection.Copy
Sheets("Temp").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Temp").Select
Sheets("Temp").Copy After:=Sheets(2)
ActiveSheet.Name = Range("B4")
Sheets("Data").Select
Next i
End Sub
Code: Select all
Dim rall As Range
Dim r As Range
With Sheets("Data")
Set rall = .Range("e2", .Range("e" & .Rows.Count).End(xlUp))
For Each r In rall
Sheets("Temp").Range("b4").Value = r.Value
Sheets("Temp").Copy after:=Sheets("Temp")
Next r
End With
Code: Select all
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.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\ตามค่า B4\ตามค่า B4.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next r
End With
End Sub
รบกวนด้วยครับsnasui wrote: แนบไฟล์ที่ได้เขียน 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 á¡pdf()
Dim i As Integer
For i = 3 To ThisWorkbook.Worksheets.Count
If FolderExist("D:\Test\" & ThisWorkbook.Worksheets(i).Range("B4").Value & "") Then
ChDir "D:\Test\" & Range("B4").Value & ""
ThisWorkbook.Worksheets(i).Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & ThisWorkbook.Worksheets(i).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\" & ThisWorkbook.Worksheets(i).Range("B4").Value & ""
ChDir "D:\Test\" & ThisWorkbook.Worksheets(i).Range("B4").Value & ""
ThisWorkbook.Worksheets(i).Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Test\" & ThisWorkbook.Worksheets(i).Range("B4").Value & "\" & Range("B4").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
ActiveWorkbook.Close False
End If
Next i
End Sub
Code: Select all
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")
Next r
End With
End Sub
Code: Select all
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")
Next r
End With
Call Module3.แยกpdf
End Sub
snasui wrote: ตัวอย่างการเรียกใช้ Code อืนภายใน Code ใด Code หนึ่งครับ
Code: Select all
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") Next r End With Call Module3.แยกpdf End Sub