Snasui Excel Forum

Posted: **Wed Oct 22, 2014 11:03 am**

พอจะแนะนำวิธีการ หรือ ไอเดีย ที่ให้ผมสามารถ 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 คงไม่ไหวแฮะๆ รบกวนผู้รู้ช่วยชีแนะด้วยนะครับ

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

Posted: **Wed Oct 22, 2014 2:25 pm**

ตัวอย่าง 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 ด้านบนครับ

Posted: **Thu Oct 23, 2014 8:18 am**

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

Posted: **Thu Oct 23, 2014 4:14 pm**

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 ให้ผมด้วยนะครับ

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

Posted: **Thu Oct 23, 2014 4:20 pm**

จาก 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

Posted: **Thu Oct 23, 2014 4:38 pm**

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:\ อย่างเดียว ครับ ช่วยชี้แนะ ผมด้วยครับ งง ไปหมดแล้ว

Posted: **Thu Oct 23, 2014 4:50 pm**

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

Posted: **Thu Oct 23, 2014 5:03 pm**

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

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

Posted: **Thu Oct 23, 2014 5:07 pm**

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

Code: Select all

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

Posted: **Fri Oct 24, 2014 8:17 am**

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

Posted: **Fri Oct 24, 2014 2:08 pm**

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 ได้ไหมครับ อาจารย์

Posted: **Fri Oct 24, 2014 3:37 pm**

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

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

Posted: **Fri Oct 24, 2014 5:08 pm**

พอดีผมมี 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

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

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

Posted: **Fri Oct 24, 2014 5:19 pm**

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

Posted: **Sat Oct 25, 2014 3:00 pm**

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 ครับ ช่วยชี้แนะด้วยครับ

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

Posted: **Sat Oct 25, 2014 3:03 pm**

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

Posted: **Sat Oct 25, 2014 3:24 pm**

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

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

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

Posted: **Sat Oct 25, 2014 3:59 pm**

ตัวอย่างการปรับ 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

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

Posted: **Sat Oct 25, 2014 4:38 pm**

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

Posted: **Sat Oct 25, 2014 4:56 pm**

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

Snasui Excel Forum

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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