Export to Excel แล้วเราสามารถระบุชื่อเรื่องได้ไหมคะ


0 สมาชิก และ 1 บุคคลทั่วไป กำลังดูหัวข้อนี้

12 ก.ค. 61 , 18:17:30
อ่าน 2358 ครั้ง

มาลี

ขอเรียนถามดังนี้นะคะ

หนูสั่ง Export ข้อมูลจาก Quary to Excel มันก็ได้ข้อมูลแบบตรงไปตรงมาได้ตามปกติค่ะ
แต่ทีนี้ หนูเกิดกิเลสหนาอยากให้ได้ไฟล์ Excel ที่มีการผสานเซล พร้อมระบุชื่อเรื่องลงไปด้วย
ถัดลงมาก็ให้เป็นแถวข้อมูลที่เรา Export ข้อมูลจาก Quary ตามปกติค่ะ

ไม่ทราบว่าสามารถทำได้หรือไม่อย่างไรคะ (ตามรูปตัวอย่างค่ะ)
ID : pbr39o-9aa58e
2018-07-12 18:15:24

 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin

12 ก.ค. 61 , 18:25:23
ตอบกลับ #1

มาลี


 

13 ก.ค. 61 , 01:44:41
ตอบกลับ #2

สันติสุข

โค๊ด: [Select]
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "ชื่อคิวรี่", "พาธ\ไฟล์.xls หรือ .xlsx", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("พาธ\ไฟล์.xls หรือ .xlsx")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:E2").merge        ' Merge Cells
        xlApp.DisplayAlerts = True
    End With
   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่อง"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With
ช่วยพกถุงผ้า/ถุงพลาสติกใช้แล้วไปซื้อของเพื่อลดการใช้พลาสติก ขยะ รักษาสิ่งแวดล้อม และไม่ให้ภาวะโลกร้อนวิกฤติเร็วขึ้นกว่านี้
ช่วยคลิกโฆษณาข้างล่างนี้ เพื่อสนับสนุนเวปบอร์ดด้วยครับ
:nice day:
 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin, prajak, มาลี

13 ก.ค. 61 , 07:05:06
ตอบกลับ #3

มาลี

 :shout: เย้...ใช้ได้ตามที่ต้องการเลยค่ะอาจารย์

หนูนำโค๊ดไปปรับแต่งใช้ดังนี้ค่ะ

Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With
   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With

End Sub

แต่ เกิดปัญหาเล็กน้อยกับไฟล์ Excel ขณะตอนเปิดไฟล์ มีแจ้งประมาณว่า ไฟล์นี้ถูกเปิดอยู่แล้ว (ตามรูปค่ะ)
ไม่ทราบว่า ต้อแก้ไขอย่างไรคะ ขอบคุณค่ะอาจารย์


 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin

13 ก.ค. 61 , 08:21:59
ตอบกลับ #4

ปิ่นณรงค์

เพิ่มคำสั่งตอนท้ายครับเป็นแบบนี้
Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With
   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With
    xlApp.ActiveWorkbook.Close True
End Sub
« แก้ไขครั้งสุดท้าย: 13 ก.ค. 61 , 08:28:07 โดย ปิ่นณรงค์ »
:love: :grin:
 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin, prajak, มาลี

13 ก.ค. 61 , 08:40:28
ตอบกลับ #5

มาลี

 :shout: เย้..ใช้ได้แล้ว ไม่ขึ้น error ตามในรูปอีกแล้วค่ะอาจารย์

ขอขอบคุณอาจารย์ทั้งสองท่านมากๆเลยนะคะ

 

13 ก.ค. 61 , 09:06:59
ตอบกลับ #6

มาลี

ขออนุญาตรบกวนเพิ่มเติมอีกนิดนะคะอาจารย์

จากคำสั่งดังกล่าว เราสามารระบุขนาดความกว้างของแต่ละเซลส์ ลงไปด้วยได้ไหมคะ

เช่น

เซลส์ A = 50 พิกเซล
เซลส์ B = 100 พิกเซล
เซลส์ C = 150 พิกเซล
เซลส์ D = 200 พิกเซล
เซลส์ E = 250 พิกเซล
เซลส์ F = 300 พิกเซล

ประมาณนี้ค่ะอาจารย์

 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin

13 ก.ค. 61 , 09:30:54
ตอบกลับ #7

ปิ่นณรงค์

Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With
   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With

With xlSheet
      .Columns("A").ColumnWidth = ......
      .Columns("B").ColumnWidth = ......
      .Columns("C").ColumnWidth = ......
      .Columns("D").ColumnWidth = ......
      .Columns("E").ColumnWidth = ......
      .Columns("F").ColumnWidth = ......
  End With   
    xlApp.ActiveWorkbook.Close True
End Sub

ตรง .....ลองกำหนดขนาดดูครับ
เพิ่มเติมนะครับถ้าอยากให้Column พอดีกับข้อความในเซล ก็ใส่เป็น
.Columns("A").EntireColumn.AutoFit


« แก้ไขครั้งสุดท้าย: 13 ก.ค. 61 , 10:03:06 โดย ปิ่นณรงค์ »
:love: :grin:
 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin, มาลี

13 ก.ค. 61 , 17:18:49
ตอบกลับ #8

มาลี

ยอดเยี่ยมเลยค่ะ..ใช้ได้ตามที่ต้องการแล้ว

ขออภัยด้วยนะคะอาจารย์ ที่หนูเข้ามารายงานผลล่าช้า พอดีโพสคำถามทิ้งไว้ แล้วออกไปทำธุระ พึ่งจะกลับมาทดสอบค่ะอาจารย์

หนูเลือกใช้คำสั่ง .Columns("A").EntireColumn.AutoFit สะดวกสวยงามได้ตามที่ต้องการเลยค่ะ

จากการทดสอบดูหลายๆครั้งแล้ว พบว่า เจ้าเซลส์ที่ประสาน มันสร้างเพิ่มขึ้นมาใหม่เรื่อยๆครั้งละ 2 แถว ตามจำนวนครั้งที่เราสั่ง Export
เช่นจาก 2 เป็น 4 เป็น 6 เป็น 8 .... ทำอย่างไรจะให้มันอัพเดต ทับแทนที่เซลส์ที่ผสานตัวเดิมไปเลย โดยไม่ต้องสร้างเซลส์ผสานกันใหม่

ในส่วนของข้อมูลนั้น OK ไม่มีปัญหาค่ะ มันอัพเดตทับแทนที่ข้อมูลเดิมไปเลยค่ะ

 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin

14 ก.ค. 61 , 08:35:57
ตอบกลับ #9

มาลี

ตอนนี้ หนูแก้ปัญหาดังกล่าวได้แล้วค่ะ
โดยการเพิ่มคำสั่ง ให้มันลบไฟล์ Excel ตััวเดิมออกไปก่อน แล้วจึงตามด้วยคำสั่ง Export ไฟล์ตัวใหม่เข้าไปแทนที่
ปิดจ๊อบได้แล้วค่ะ

 

14 ก.ค. 61 , 12:34:02
ตอบกลับ #10

TTT

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

    Set xlSheet = xlWorkbook.ActiveSheet
    '-------------ตรวจสอบหากมีหัวเรื่องชื่อเดียวกันซ้ำก็ให้ข้ามการแทรกไป
    If xlSheet.Cells(1, 1).Value = "ชื่อหัวเรื่องที่ต้องการ" Then Exit Sub
    '-------------------------------------------------
    With xlSheet.Range("A1")
ฐานข้อมูลเป็นเรื่องใกล้ตัว ใครๆก็ทำฐานข้อมูลเองได้นะครับhttp://www.youtube.com/c/AccessCreator
 
โพสต์นี้ได้รับคำขอบคุณจาก: pirin, มาลี

15 ก.ค. 61 , 13:45:19
ตอบกลับ #11

มาลี

ขอบคุณค่ะอาจารย์TTT
หนูจะลองนำไปปรับแก้ดูนะคะ

 

30 ก.ค. 61 , 17:16:42
ตอบกลับ #12

มาลี

ขออนุญาตถามเพิ่มต่อจากโค๊ดนี้ค่ะ
โค๊ด: [Select]
Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With
   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With

With xlSheet
      .Columns("A").ColumnWidth = ......
      .Columns("B").ColumnWidth = ......
      .Columns("C").ColumnWidth = ......
      .Columns("D").ColumnWidth = ......
      .Columns("E").ColumnWidth = ......
      .Columns("F").ColumnWidth = ......
  End With   
    xlApp.ActiveWorkbook.Close True
End Sub

จากโค๊ดข้างบนนี้ หากเราต้องการจะกำหนดขนาด/แบบอักษร เฉพาะแถวที่ 5
สมมติให้เป็น tahoma ขนาด 11 (เฉพาะแถวที่5) ต้องเพิ่มเติมคำสั่งอย่างไรคะ

หรือหากจะสั่งให้ทุแถวให้เป็น tahoma ขนาด 11 ทั้งหมดเลยต้องทำอย่างไรคะอาจารย์
 

 

31 ก.ค. 61 , 10:24:28
ตอบกลับ #13

ปิ่นณรงค์

อ้างถึง
สั่งให้ทุแถวให้เป็น tahoma ขนาด 11 ทั้งหมดเลยต้องทำอย่างไรคะ

Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With 
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With

With xlSheet
        .Font.Name = "Tahoma"
        .Font.Size = 11        'กำหนดขนาด
        .Font.Bold = false     'กำหนดตัวหนาหรือปกติ
        .Columns("A").ColumnWidth = ......
        .Columns("B").ColumnWidth = ......
        .Columns("C").ColumnWidth = ......
        .Columns("D").ColumnWidth = ......
        .Columns("E").ColumnWidth = ......
        .Columns("F").ColumnWidth = ......
  End With   
    xlApp.ActiveWorkbook.Close True
End Sub
« แก้ไขครั้งสุดท้าย: 31 ก.ค. 61 , 10:30:13 โดย ปิ่นณรงค์ »
:love: :grin:
 
โพสต์นี้ได้รับคำขอบคุณจาก: มาลี

31 ก.ค. 61 , 19:49:36
ตอบกลับ #14

มาลี

ยังไม่ได้ค่ะอาจาย์ มันขึ้นแถบสีเหลืองตามรูปค่ะอาจารย์

 

31 ก.ค. 61 , 21:38:38
ตอบกลับ #15

ปิ่นณรงค์

Private Sub Command0_Click()
    Dim xlApp           As Object
    Dim xlWorkbook      As Object
    Dim xlSheet         As Object
   
    DoCmd.TransferSpreadsheet acExport, , "Query1", "D:\ExportQuery1.xls", True
   
    Set xlApp = CreateObject("excel.application")
    Set xlWorkbook = xlApp.Workbooks.Open("D:\ExportQuery1.xls")
    Set xlSheet = xlWorkbook.activesheet

    With xlSheet.range("A1")
        .entirerow.insert -4121             ' Insert and Shift Row Down
        .entirerow.insert -4121             ' Insert and Shift Row Down
        xlApp.DisplayAlerts = False
        xlSheet.range("A1:F2").merge        ' Merge Cells (ผสานเซล A1:F2)
        xlApp.DisplayAlerts = True
    End With

With xlSheet.Cells.Font
         .name = "Tahoma"
         .FontStyle = "Regular"
         .Size = 11
End With

   
    With xlSheet.range("A1")
        .Value = "ชื่อหัวเรื่องที่ต้องการ"
        .Font.Name = "Tahoma"
        .Font.Size = 18
        .Font.Bold = True
        .HorizontalAlignment = -4108        ' Align Center
    End With


With xlSheet
      .Columns("A").ColumnWidth = ......
      .Columns("B").ColumnWidth = ......
      .Columns("C").ColumnWidth = ......
      .Columns("D").ColumnWidth = ......
      .Columns("E").ColumnWidth = ......
      .Columns("F").ColumnWidth = ......
  End With   
    xlApp.ActiveWorkbook.Close True
End Sub

ลองใหม่ครับได้ไหม
« แก้ไขครั้งสุดท้าย: 31 ก.ค. 61 , 21:46:05 โดย ปิ่นณรงค์ »
:love: :grin:
 
โพสต์นี้ได้รับคำขอบคุณจาก: มาลี

01 ส.ค. 61 , 06:00:46
ตอบกลับ #16

มาลี

 :shout: เย้.. สำเร็จแล้วค่ะอาจารย์

ขอขอบคุณมากๆเลยนะคะ

 

18 ต.ค. 62 , 20:34:06
ตอบกลับ #17

iamkob

  • สมาชิกไท.Access
  • กระทู้: 1

  • ขอบคุณ ไท.Access

    • ดูรายละเอียด

สวัสดีครับ ผมมือใหม่ เข้ามาหาข้อมูล export query to excel เห็นกระทู้นี้ดูคล้ายกับที่ผมอยากทำ แต่อยากสอบถามเพิ่มเติมครับ
1 ถ้าเราจะจัดข้อความใน cell ให้ชิดซ้ายและขวา ให้ตัวเลขอะไรครับ
2 ถ้าต้องการตีกรอบเป็นตารางใช้คำสั่งอะไรครับ
3 ทำไมบางครั้ง พอ export ไปสักพัก excel จะ add sheet ใหม่แทน เช่นผมตั้งชื่อ sheet1 ให้ export ไปที่ sheet1 แต่พอ export ไป 3  หรือ 4 ครั้ง มันจะ add sheet11 แทนอะครับ
ขอคุณสำหรับคำตอบล่วงหน้าครับ

 


บอร์ดเรียนรู้ Access สำหรับคนไทย


 

Sitemap 1 2 3 4 5