ضمن سلام و تبریک عید سعید فطر و آرزوی قبولی طاعات و عبادات همه دوستان عزیز
پیرو سوال و درخواست یکی از دوستان در خصوص ارسال مشروط اطلاعات یک کوئری به اکسل امروز ایده ای برای این منظور به ذهنم رسید که تصمیم گرفتم برای استفاده دوستان آموزش آن را در اینجا قرار بدهم
ابتدا یک تابع برای ساخت کوئری موقت ایجاد می کنیم:
Sub CreateQry(sQryName As String, sSQL As String)
On Error Resume Next
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDb
With db
.QueryDefs.Delete (sQryName)
Set qdf = .CreateQueryDef(sQryName, sSQL) 'Create the query
End With
db.QueryDefs.Refresh
End Sub
در مرحله بعد کد اسکیوال کلی و بدون شرط آن کوئری ایکه میخواهیم اطلاعات آن را به اکسل ارسال کنیم در یک متغییر با نام LoadSql قرار میدهیم و آن را در رویداد Form_Load فرم درج می نمائیم . در همین رویداد آدرس فایل اکسل مربوطه نیز قرار میدهیم
Private Sub Form_Load()
strPath = CurrentProject.path & "\DataExcel.xlsx"
LoadSql = "SELECT Table2.Code_Perseneli, Table1.First_Name, Table1.Last_Name, Table2.Monthly_Salary, Table2.Working_Holidays, Table2.Overtime_Working" & _
" FROM Table2 LEFT JOIN Table1 ON Table2.Code_Perseneli = Table1.Code_Perseneli"
End Sub
همانطور که از کدهای اسکیوال مشاهده میشود کوئری مربوطه از رابطه دوجدول به نام های Table1 و Table2 تشکیل شده
در مرحله بعد در رویداد کلیک دکمه cmdFilter که برای فیلتر کردن اطلاعات فرم در نظر گرفته شده کدهای زیر که شامل کد فیلتر نمودن اطلاعات است رو قرار می کنیم:
Private Sub cmdFilter_Click()
If Len(Txtcode) = 0 And Len(TxtFirst_Name) = 0 And Len(TxtLast_Name) = 0 Then Exit Sub
CmdUnFilter.Visible = True
CmdUnFilter.SetFocus
cmdFilter.Visible = False
strFilter = ""
strFilter = "Table2.Code_Perseneli like '*" & Me.Txtcode & "*' AND Table1.First_Name like '*" & Me.TxtFirst_Name & "*' AND Table1.Last_Name like '*" & Me.TxtLast_Name & "*'"
Me.Filter = strFilter
Me.FilterOn = True
End Sub
در کدهای زیر نیز در کلیک کلید CmdUnFilterکه برای خارج نمودن اطلاعات از حالت فیلتر تعبیه شده کدهای زیر را وارد کرده ایم :
Private Sub CmdUnFilter_Click()
On Error Resume Next
Me.Filter = ""
Me.FilterOn = False
Me.Txtcode = Null
Me.TxtFirst_Name = Null
Me.TxtLast_Name = Null
Me.Requery
cmdFilter.Visible = True
cmdFilter.SetFocus
CmdUnFilter.Visible = False
End Sub
بر روی فرم کلید های CmdFilter و CmdUnFilter بر روی هم قرار گرفته اند که با ظاهر شدن یکی دیگری مخفی میشود
و در نهایت در رویداد کلید CmdExportToExcel که مربوط ارسال اطلاعات به اکسل است کدهای زیر رو وارد می کنیم :
Private Sub CmdExportToExcel_Click()
On Error Resume Next
Dim Sql As String
Dim StrWhere As String
StrWhere = " WHERE " & strFilter
If Len(Txtcode) > 0 Or Len(TxtFirst_Name) > 0 Or Len(TxtLast_Name) > 0 Then
Sql = LoadSql & StrWhere
Else
Sql = LoadSql
End If
CreateQry "Q1", Sql
DoCmd.OutputTo acOutputQuery, "Q1", "Excel Workbook (*.xlsx)", strPath, True, "", 0
End Sub
دوستانی که تمایل دارند این کدهای رو در برنامه خودشان پیاده کنن توجه داشته باشند برای استخراج کد کوئری طبق تصویر ضمیمه کوئری مربوطه رو در حالت دیزاین باز کنن و از قسمت SQL Vievکدها را کپی و در متغیر LoadSql قرار بدهند . توجه شود علامت سیمی کالن(; ) از آخر کدها حذف شود.
نوشته شده توسط eb_1345
پاسخ با نقل قول