การ copy ข้อมูล และ save แต่ละ sheets เป็น .text ครับ

[sammam]

พอจะแนะนำวิธีการ หรือ ไอเดีย ที่ให้ผมสามารถ copy ข้อมูลแต่ละชุด แล้ว วางใน sheet ที่ชื่อเหมือนกันกับข้อมมูล เช่นข้อมูล A ก็วางใน sheet A

พอดีผม มีข้อมูลชุดหนึ่งครับ

A 1 1
A 1 1
A 1 1
A 1 1

B 2 2
B 2 2
B 2 2
B 2 2
B 2 2

C 3 3
C 3 3
C 3 3
C 3 3

D 4 4
D 4 4
D 4 4
D 4 4

1.ผมได้สร้าง sheet A,B,C,D ไว้รอแล้ว
ไม่รู้ว่าจะใช้ วิธีไหนที่ จะ copy ข้อมูลชุด A ไปไว้ ใน sheet A , ข้อมูลชุด B ไปไว้ ใน sheet B , ข้อมูลชุด C ไปไว้ ใน sheet C ตามลำดับครับ

2.การ save as ของแต่ละ sheet A,B,C,D ให้เป็น .text โดยใช้ macro vba ครับ


ปล ข้อมูลผมมี เยอะมากครับ ประมาณ 1000 ชุดข้อมูล ถ้า copy แต่ละชุดข้อมมูล แล้ววางที่ notepad คงไม่ไหวแฮะๆ รบกวนผู้รู้ช่วยชีแนะด้วยนะครับ


ขอบคุณ มากครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub Test0()
    Dim sh As Worksheet
    Dim rngSource As Range
    Dim rng As Range
    With Sheets("DAT")
        Set rngSource = .Range("a1", .Range("a" & .Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants)
        For Each rng In rngSource
            Sheets(rng.Value).Range("a" & Rows.Count).End(xlUp) _
                .Offset(1, 0).Resize(1, 3).Value = rng.Resize(1, 3).Value
        Next rng
    End With
End Sub

ในโอกาสถัดไป ให้แจ้งมาด้วยว่า Code ที่เขียนเองแล้วนั้นชื่ออะไร ติดขัดบรรทัดใด ตามกฎข้อ 5 ด้านบนครับ

[sammam]

ขอบคุณครับอาจารย์ ผมจะลองทำดูครับ พอดีผมมือใหม่มากๆเลย ครับ แฮะๆๆ ขอบคุณมากนะครับ

[sammam]

Sub wsToText()
Dim ws As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets

Sheets(ws.Name).Select
Sheets(ws.Name).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Administrator\Desktop\text for app" & ws.Name & ".txt", _
FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
ThisWorkbook.Activate
Next ws

End Sub


อาจารย์ครับ ผมลองเขียน code ว่าจะให้แต่ละ sheet ที่ผมมี save as เป็น .text ผมอยากให้มัน save ลง folder ชื่อ ว่า text for app ครับ แต่มัน save ลงหน้า desktop หมดเลยครับ อาจารย์ลองช่วยดู code ให้ผมด้วยนะครับ

ขอบคุณมากครับ อาจารย์

[snasui]

จาก Code "C:\Users\Administrator\Desktop\text for app" & ws.Name & ".txt", _
FileFormat:=xlText, CreateBackup:=False เป็นการอ้างถึง Desktop ให้เปลี่ยนเป็น Path ที่ต้องการ

ช่วยโพสต์ Code ให้แสดงเป็น Code ดูตัวอย่างจากระทู้นี้ครับ viewtopic.php?style=3&f=3&t=1187

[sammam]

Code: Select all

Sub wsToText()
    Dim ws As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
         
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.SaveAs Filename:= _
        "D:\text for app" & ws.Name, _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ThisWorkbook.Activate
    Next ws
     
End Sub

ผมเปลี่ยนเป็น D:\text for app มันยังไม่ save ลง folder text for app มัน save ลง D:\ อย่างเดียว ครับ ช่วยชี้แนะ ผมด้วยครับ งง ไปหมดแล้ว

[snasui]

เท่าที่ดู Code น่าจะ Save ได้ถูกตำแหน่งแล้ว ลองแนบไฟล์นั้นมาดูกันครับ

[sammam]

อาจารย์ช่วยลองดูให้ผมด้วยนะครับ

ขอบคุณมากครับ อาจารย์

[snasui]

เพิ่ม \ เข้าไปอีกอักขระครับ เป็น

Code: Select all

"D:\text for app\" & ws.Name, _
        FileFormat:=xlText, CreateBackup:=False

[sammam]

เย่ๆๆ ได้แล้วครับ อาจารย์ ขอบคุณมากนะครับ

[sammam]

Code: Select all

Sub wsToText()
    Dim ws As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
         
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.SaveAs Filename:= _
        "D:\text for app\" & ws.Name, _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ThisWorkbook.Activate
    Next ws
     
End Sub

อาจารย์ พอจะมีแนวทาง save จาก excel ให้เป็น .jpg ได้ไหมครับ อาจารย์

[snasui]

เราสามารถสร้าง Chart มารับ Object ที่สร้างขึ้นใน Excel แล้ว Export Chart นั้นไปเป็น .jpg ผลทีได้ก็คือ Object ที่เป็น jpg

กรณีข้อมูลเป็นตารางก็สามารถที่จะ Copy ตารางแล้วางให้เป็น Picture (Object) ก่อนแล้วค่อยทำตามด้านบน

[sammam]

พอดีผมมี Code ที่ save chart เป็น .gif แล้วครับ

คือ อันนี้

Code: Select all

Sub Create_GIF()
Dim mychart As Chart
Set mychart = ActiveSheet.ChartObjects("Sheet1").Chart
mychart.Export Filename:="D:\Mychart.gif", FilterName:="GIF"
End Sub

แต่ยังไม่สามารถนำมาปรับใช้ กับ code ข้องล่างได้ครับ ไม่รู้ว่าต้องทำยังไงให้ chart มารองรับ code ด้านล่าง

Code: Select all

Sub Test0()
    Dim sh As Worksheet
    Dim rngSource As Range
    Dim rng As Range
    With Sheets("DAT")
        Set rngSource = .Range("a1", .Range("a" & .Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants)
        For Each rng In rngSource
            Sheets(rng.Value).Range("a" & Rows.Count).End(xlUp) _
                .Offset(1, 0).Resize(1, 3).Value = rng.Resize(1, 3).Value
        Next rng
    End With
End Sub

รบกวนอาจารย์อีกครั้งหนึ่งครับผม ช่วยชี้แนะ ด้วยครับ

ขอบคุณมากครับอาจารย์

[snasui]

ให้ Copy Range ไปเป็น Picture มาก่อน ถ้าทำไม่เป็นให้บันทึก Macro แล้วดู Code ครับ

[sammam]

Code: Select all

Sub wsToText()
    Dim ws As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
         
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "D:\text for app\" & ws.Name, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close
        ThisWorkbook.Activate
    Next ws
     
End Sub

อาจารย์ครับ ทำไม มันerror ผมว่าจะ save เป็น PDF ครับ ช่วยชี้แนะด้วยครับ

ขอบคุณมากครับอาจารย์

[snasui]

แนบไฟล์ตัวอย่างมาด้วยจะได้ช่วยทดสอบได้ครับ

[sammam]

ไฟล์ นี้ครับอาจารย์

ขอบคุณมากนะครับอาจารย์

เกรงใจอาจารย์ จังเลยครับ

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

For Each ws In ThisWorkbook.Worksheets
    ws.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "D:\text for app\" & ws.Name & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
Next ws

สำหรับการถามตอบปัญหาสามารถสอบถามกันได้เต็มที่ ไม่มีข้อกำหนดว่าให้ถามได้เพียงเท่านั้นเท่านี้ครั้ง ถ้ายังเกิดปัญหาสามารถถามมาได้เรือ่ย ๆ เท่าที่ต้องการ ผมสร้างฟอรัมเพื่อให้สมาชิกได้ถามตอบปัญหากันโดยเฉพาะ ไม่ต้องเกรงใจครับ

[sammam]

ยัง error อยู่เลยครับอาจารย์ excel มันไม่ save เป็น pdf แต่มันกลับสร้าง file excel อันใหม่ ที่มีชื่อ sheet เป็น test run ครับ แฮะๆ

[snasui]

ผมทดสอบด้วย Excel 2010 ไม่ติดปัญหาใดครับ