สอบถามโค้ด Export excel ให้เป็น Full screen ครับ

[001Jetnipit]

คือ Form ผมเป็น Popup ถ้าหาก เวลากดปุ่ม Export เป็น Popup ด้วยมันไม่เด้งมาโชว์ข้างหน้าโปรแกรมครับ แต่ถ้าเป็นแบบ Full screen จะไม่มีปัญหาครับ

โค้ดที่ผมใช้แล้วมันเป็น Full screen
Dim sFilename As String
    sFilename = "D:\TestProject\Results.xlsx"
    DoCmd.OutputTo acOutputQuery, "Q_PI_Checkbox", acFormatXLSX, sFilename, True

โค้ดนี้จะ Export ข้อมูลตามที่เราค้นหา แต่ผมไม่แน่ใจว่าจะเอาโค้ดข้างบนไปดัดแปลงใส่ข้างล่างตรงไหนครับ
Dim xlapp As Object
Dim i As Long
If Me.Dirty Then Me.Dirty = False
Dim rsClone As DAO.Recordset
Set rsClone = Me.PIT.Form.RecordsetClone
If rsClone.EOF Then
MsgBox "ไม่มีข้อมูลที่จะ Export!!", vbCritical, "สถานะ"
Set rsClone = Nothing
Exit Sub
End If


Set xlapp = CreateObject("excel.application")
With xlapp
.Visible = True
.workbooks.Add
.sheets("Sheet1").select

.activesheet.range("A2").copyfromrecordset rsClone
For i = 1 To rsClone.Fields.Count

xlapp.activesheet.Cells(1, i).Value = rsClone.Fields(i - 1).Name
Next i
xlapp.Cells.EntireColumn.AutoFit
End With

[PNR]

ลองเพิ่มตรงสีแดงเข้าไปว่าได้ไหม
  Set xlapp = CreateObject("excel.application")
  With xlApp
        .Visible = True
        .DisplayFullScreen = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
        .ActiveSheet.Range("A2").CopyFromRecordset rsClone

[001Jetnipit]

ลองเพิ่มตรงสีแดงเข้าไปว่าได้ไหม
  Set xlapp = CreateObject("excel.application")
  With xlApp
        .Visible = True
        .DisplayFullScreen = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
        .ActiveSheet.Range("A2").CopyFromRecordset rsClone

มัน Full จริงครับ แต่ปัญหาเดิมยังอยู่ครับ คือมันกระพริบแบบนี้แล้วเราต้องกดเอง


 ต่างกับปุ่ม Export อีกปุ่มมันจะเด้งหน้า Excel มาเลยครับ

เป็นเพราะผมไปปิดอะไรในนี้หรือเปล่าครับ กด Shift+ ดับเบิ้ลคลิ๊ก แล้วเปิด Form ขึ้นมา Excel ก็เด้งมาข้างหน้าปกติ แต่ถ้าหากดูโหมดแบบซ่อน Table ปัญหาก็จะเป็นตามข้างต้นเลยครับ

[001Jetnipit]

ขอบคุณครับ ได้แล้วครับ

โดยการสร้างตาราง Temp มาเก็บข้อมูลที่ค้าหามาเก็บไว้ชั่วคราวแล้วค่อยเอาโค้ดด้านบน Export ออกครับ

โค๊ด: [Select]

Dim db As Database
Dim rsClone As DAO.Recordset
Dim rsptTemp As Recordset
Dim sFilename As String

'If MsgBox("You want to export to excel ??", vbQuestion + vbYesNo, "Confirm") = vbYes Then
Set db = CurrentDb
db.Execute "delete * from pi_temp;"

Set rsClone = Me.PIT.Form.RecordsetClone
Set rsptTemp = db.OpenRecordset("PI_Temp", dbOpenDynaset)
rsClone.MoveFirst
Do Until rsClone.EOF
rsptTemp.AddNew
rsptTemp![ID_Card] = rsClone![ID_Card]
rsptTemp![Code] = rsClone![Code]
rsptTemp![NameTH] = rsClone![NameTH]
rsptTemp![NameEN] = rsClone![NameEN]
rsptTemp![Position] = rsClone![Position]
rsptTemp![NickName] = rsClone![NickName]
rsptTemp![Section] = rsClone![Section]
rsptTemp![Department] = rsClone![Department]
rsptTemp![Mobile] = rsClone![Mobile]
rsptTemp![Sex] = rsClone![Sex]
rsptTemp![Blood_Type] = rsClone![Blood_Type]
rsptTemp![E-mail] = rsClone![E-mail]
rsptTemp![ComStart] = rsClone![ComStart]
rsptTemp![ComAge] = rsClone![ComAge]
rsptTemp![Transaction_NO] = rsClone![Transaction_NO]
rsptTemp![DOB] = rsClone![DOB]
rsptTemp![OwnAge] = rsClone![OwnAge]
rsptTemp![Education] = rsClone![Education]
rsptTemp![Domicile] = rsClone![Domicile]
rsptTemp.Update
rsClone.MoveNext
Loop
rsClone.Close: Set rsClone = Nothing
rsptTemp.Close: Set rsptTemp = Nothing
'End If

    sFilename = "D:\TestProject\Results.xlsx"
    DoCmd.OutputTo acOutputTable, "PI_Temp", acFormatXLSX, sFilename, True