تعديل كود معين لاترحيل اكتر من صف بدل صف واحد الي الاكسيل

[ahmed_2040]

الرجاء منك تصحيح الكود التالي ليختار من الليست بوكس اكتر من صف لانه بيتم ترحيل اخر صف فقط انا بختارة مع اني باكون محدد صفوف تانية غيره

Dim DataExp As String

  For Each varItm In SearchList.ItemsSelected
'",  DataExp = DataExp & "[" & Me.SearchList.ItemData([varItm]) & "]
" ' " &  DataExp = "SELECT * FROM Data_Tech WHERE [a1] = ' " & Me.SearchList.Column(0, [varItm]) 
  
Next varItm

Set QFEx = CurrentDb.CreateQueryDef("Qtoexport", DataExp)
DoCmd.OutputTo acOutputQuery, "Qtoexport", acViewPreview
"DoCmd.DeleteObject acQuery, "Qtoexport

searchlist ده الليست فيو او الليست بوكس

data_Tech  ده اسم الجدول عندي في قاعدة البيانات

[ناقل]

هل تريد تصدير الصفوف المختارة في ملف اكسل واحد ..... ام تريد ترحيل كل صف الى ملف اكسل مستقل ؟؟؟؟

( الرجاء ارفاق ملفك )

[ahmed_2040]

لا اريد في ملف اكسيل واحد انا كل مشكلتي منحصرة في كود التحديد من الليست بوكس 

وده مرفق معد به كود اخر من موقع اجنبي لكن لا يعمل اي لايستخرج بينات

بيانات التوجبه.rar

تم تعديل أكتوبر 24, 2021 بواسطه ahmed_2040

[ناقل]

16 دقائق مضت, ahmed_2040 said:

لا اريد في ملف اكسيل واحد انا كل مشكلتي منحصرة في كود التحديد من الليست بوكس 

طيب حددت بعدين ؟؟؟؟ اشرح بالكامل رجاءا

[ahmed_2040]

اريد ترحيل البينات المحددة في الليست بوكس الي استعلام جديد او الي ملف اكسيل 

والكلام ده مرفق في الملف

بيانات التوجبه.rar

[ناقل]

3 ساعات مضت, ahmed_2040 said:

اريد ترحيل البينات المحددة في الليست بوكس الي استعلام جديد او الي ملف اكسيل 

والكلام ده مرفق في الملف

اصنع زر في النموذج وضع فيه هذا الكود بارك الله فيك ...... بعد اختيار السجلات اضغط على الزر ليفتح لك استعلام وبه السجلات المختارة

On Error GoTo Err_cmdRunQuery1_Click
    
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL As String, strWhere As String
Dim i As Integer

Set db = CurrentDb

strSQL = "SELECT Data_Tech.* FROM Data_Tech "
strWhere = "Where a1 IN( "
For i = 0 To SearchList.ListCount - 1
    If SearchList.Selected(i) Then
        strWhere = strWhere & "'" & SearchList.Column(0, i) & "', "
    End If
Next i
strWhere = Left(strWhere, Len(strWhere) - 2) & ");"
strSQL = strSQL & strWhere

db.QueryDefs.delete "qryMyQuery"
Set qdf = db.CreateQueryDef("qryMyQuery", strSQL)


DoCmd.OpenQuery "qryMyQuery", acNormal, acEdit

Exit_cmdRunQuery1_Click:
    Exit Sub

Err_cmdRunQuery1_Click:
    If Err.Number = 3265 Then
        Resume Next
    Else
        MsgBox Err.Description
        Resume Exit_cmdRunQuery1_Click
    End If

تفضل مرفقك بعد التعديل عليه واضافة الزر .... طبق اعلمنا بالنتيجة .....

 

بيانات التوجبه (1).rar

[ahmed_2040]

السلام عليكم 

حضرتك استاذ ورئيس قسم والله 

حضرتك حلتلي مشكلة حيرتني اسبوعين 

الكود ده هو المطلوب بالظبط 

بارك الله فيك 

 

[ناقل]

33 دقائق مضت, ahmed_2040 said:

السلام عليكم 

حضرتك استاذ ورئيس قسم والله 

حضرتك حلتلي مشكلة حيرتني اسبوعين 

الكود ده هو المطلوب بالظبط 

بارك الله فيك 

 

بل انا تلميذ وطالب علم اتعلم من الاساتذة امثالكم 

بارك الله فيك ....

[sameh_awad]

جزاكم الله خيرا

[ahmed_2040]

كل الشكر لك وللمساعدة التي قدمتها الي 

فاضل اخر حاجة وهو اكمال المشروع بالتصدير من الاستعلام الي الاكسيل لكن كل ما اقوم بموضوع التصدير تظهر تلك الرسالة 

مرفق ملف للتوضيح

بيانات التوجبه نهائي معدل.rar

[د.كاف يار]

مشكلتك تكون في هذا السطر

     DTPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
     curPath = DTPath & "\salah- " & Format(Date, "dd-mm-yyyy") & ".xl'sx"

لم سيتطع التعرف على تنسيق ملف الإخراج xl 

و الصحيح xls  / xlsx

تفضل التعديل

بيانات التوجبه نهائي معدل.accdb

[ahmed_2040]

يا سلام عليك استاذ وربنا 

بارك الله فيك وجعله في ميزان حسناتك ياكبير الخبراء

[ahmed_2040]

بعد التجربة وجدت ان تجهيز ملف الاكسيل بياخد وقت طويل جدا لا نشائة 

قما السبب ؟؟

[ahmed_2040]

الرجاء التعديل علي هذا المرفق الاخير لقاعدة البيانات بحيث يخرج اعمده مختارة وصفوف مختارة 

وشكرااا

بيانات التوجبه نهائي معدل.rar

[ahmed_2040]

تمام شكرا للجميع نجحت في برمحة المطلوب