خروجی سابفرم به اکسل

[Masoud.eh]

سلام دوستان گرامی
لطفا میشه دوستان کمک کنن که چجوری در کد زیر بجای فرم، سابفرم رو معرفی کنم؟

DoCmd.OutputTo acOutputForm, "frmS_LOADING", "ExcelWorkbook(*.xlsx)", Path2, True


سابفرم رو به اشکال زیر معرفی کردم ولی جواب نگرفتم

DoCmd.OutputTo acOutputForm, Form_frm_Main.sub_Main, "ExcelWorkbook(*.xlsx)", Path2, True

DoCmd.OutputTo acOutputForm, "Forms!frm_Main!sub_Main", "ExcelWorkbook(*.xlsx)", Path2, True

ممنون میشم راهنمایی بفرمائید.

[simorgh2000]

سلام دوست عزیز
بهتره سورس فرم یک کوئری قرار بدید و نتیجه کوئری به اکسل بفرستین اینجوری نام فیلدها در اکسل هم بصورت فارسی خواهد بود

[Masoud.eh]

دوست عزیز
سورس فرم کوئری در صورتی که فیلترهای خود اکسس اعمال بشه (فیلترهای مثل sort، Equals و ... در فرم دیتاشیت) نتیجه فیلتر در اکسل نمیاد و فقط فیلترهای اعمال شده در کوئری (و فرم اصلی متصل به کوئری) در اکسل خروجی مشاهده میشه.
بنابراین به نظر میاد برای خروجی اکسل از کلیه فیلترهای اعمال شده (چه فیلترهای خود اکسس و چه فیلترهای اعمال شده در کوئری) بایستی مستقیما از سابفرم خروجی اکسل گرفت.

[mazoolagh]

سلام و روز خوش

دو مورد هست که باید در نظر داشته باشین:

1- با فرض این که اسم کنترل subform شما در فرم اصلی sub_Main باشه میتونین اینجوری بنویسین:
DoCmd.OutputTo acOutputForm, me.sub_Main.form.name, "ExcelWorkbook(*.xlsx)", Path2, True

یا اصلا مستقیما اسم خود سابفرم (نه کنترل):
DoCmd.OutputTo acOutputForm, "your subform name", "ExcelWorkbook(*.xlsx)", Path2, True

2- مشکل شما با این روش حل نمیشه!
درسته که docmd.outputto هنگام اکسپورت به excel وضعیت فیلتر و سورت فرم رو در نظر میگیره،
ولی این در مورد سابفرم عمل نمیکنه.
گذشته از این، کل کوردهای دیتاسورس سابفرم اکسپورت میشه و نه رکوردهای نمایش داده شده در سابفرم.

راهنمایی جناب سیمرغ در پست 2 درست هست،
ولی باید وضعیت فیلتر و سورت رو هم خودتون در کوئری پیاده کنین که کدنویسی اش سخت میشه.

ولی میتونین به صورت زیر عمل کنین:
1- یک جدول موقت بسازین
2- و اون رو از روی رکوردست سابفرم پر کنین (در واقع از روی recordsetclone)
3- و این جدول رو اکسپورت کنین

[anoor_h]

این خیلی خوب عمل میکنه من دارمش




Private Sub Command53_Click()
On Error Resume Next
DoCmd.DeleteObject acQuery, strTempQryDef
On Error GoTo 0
Dim db As dao.Database
Dim qrydef As dao.QueryDef


Dim strSQL As String
Dim bolWithFilterOn As Boolean

Dim strRecordSource As String




strTempQryDef = combo22.Value


bolWithFilterOn = Me.sheet2subform.Form.FilterOn


strRecordSource = Me.sheet2subform.Form.RecordSource


If InStr(strRecordSource, "SELECT ") <> 0 Then
strSQL = strRecordSource
Else
strSQL = "SELECT * FROM [" & strRecordSource & "]"
End If


' just in case our sql string ends with ";"
strSQL = Replace(strSQL, ";", "")


If bolWithFilterOn Then
strSQL = strSQL & _
IIf(InStr(strSQL, "WHERE ") <> 0, " And ", " Where ") & _
Me.sheet2subform.Form.Filter
End If


Set db = CurrentDb
On Error GoTo m:
'create temporary query
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
''db.QueryDefs.Append qrydef
Set qrydef = Nothing


DoCmd.TransferSpreadsheet TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=strTempQryDef, _
Filename:=Replace(CurrentProject.Path & "\Tak" & "", "\", "") & strTempQryDef & ".xlsx"
wkbookPath = Replace(CurrentProject.Path & "\Tak" & "", "\", "") & strTempQryDef & ".xlsx"
Dim XL As Object
Set XL = CreateObject("Excel.Application")
With XL
.Visible = False
.DisplayAlerts = False
.Workbooks.Open wkbookPath
.Columns("A:G").EntireColumn.AutoFit
.ActiveWorkbook.Close (True)
.Quit
End With
Set XL = Nothing
' Delete the temporary query
db.QueryDefs.Delete strTempQryDef
Combo21.Requery
Set db = Nothing
Exit Sub:
m:
MsgBox "نقطه اي انتخاب نشده"

[Masoud.eh]

ممنون از پاسختون
از کد زیر جدیدا استفاده کردم که عالی عمل کرد
فقط دو مورد هست که اگر اصلاحش کنید ممنون میشم
1- اینکه فایل اکسل با نام و آدرس داده شده بصورت خودکار ذخیره بشه. (در path1 و path2)
2- ستون ها با توجه به فرم دیتاشیت راست چین، چپ چین یا وسط چین باشه.



Path1 = CurrentProject.Path & "" & Replace("Report", ChrW(1740), ChrW(1610))

If Len(Dir(Path1 & "", vbDirectory)) = 0 Then
MkDir Path1
End If

"Path2 = CurrentProject.Path & "\Report" & "\DISCHARG-" & Me.txt_DateTime & ".xlsx

Private Sub Command287_Click()

On Error GoTo Command287_Click_Err
Me.sub_Main.SetFocus

DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy

Dim xlapp As Object
Set xlapp = CreateObject("Excel.Application")

With xlapp
.Workbooks.add
.activesheet.PasteSpecial Format:=2, Link:=False, DisplayAsIcon:=False
.range("a1").EntireRow.Delete
.Visible = True
.Columns.WrapText = False
.Columns.AutoFit


Command287_Click_Exit:
Exit Sub

End With
Command287_Click_Err:
MsgBox Error$
Resume Command287_Click_Exit

End Sub

[mazoolagh]

برای فرمت بندی سلول های داکیومنت اکسل فکر کنم تاپیک داشتیم.