listbox نقل الحقول من الكمبو بوكس الي vba

[ahmed_204079]

دمك خفيف يابو جودي والله 

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

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

انا وضعت الكود في حدث After updte  في الليست الصغيرة listfields 

اولا: لما بختار عنصر من اليست الصغيرة  listfields عن طريق النقر المفرد اول كلمة وهي مسلسل لا تظهر في الليست الكبيرة SearchListEXP واختار كلمة الكود بعدها تظهر ثم اسم المعلم المهم ان اول اختيار مش بيظهر ويظهرالاختيار اللي يليلة 

ثانيا اليست الكبيرة SearchListEXP لا يظهر بها شريط تمرير من الاسفل وكل ما اضيف حقول بتضضيق وبتتخنق والبينات مش بتبقي واضحة 

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

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

مرفق ملف صغير للتوضيح بعد اضافة الكود بتاعك لليست listfields 

[ahmed_204079]

اقتباس

Private Sub cmd_Export_NEW_Click()
'n Error GoTo err_cmd_Export_NEW_Click
'On Error Resume Next
Dim curPath As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim L, j, k As Integer
Dim str_SQL As String
Dim strFieldList As String, strIN As String
Dim QDF1 As DAO.QueryDef
'*****************************
Dim i As Integer
Dim strSQL As String, strWhere As String
Dim QDF2 As DAO.QueryDef
'*****************************
Dim xlApp1 As Object
Dim xlWB1 As Object
    DTpath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    curPath = DTpath & "\معلمين ابتدائي- " & Format(Date, "dd-mm-yyyy") & ".xlsx"
'******************************
DoCmd.DeleteObject acQuery, "qryMyQuery"
DoCmd.DeleteObject acQuery, "QForExport"
If SearchListEXp.ItemsSelected.Count = 0 Or ListFields.Selected(0) = False Then
Beep
MsgBox "اختر الحقول مراد تصديرهم من خلال اختيار الجدول ثم اختيار الحقل", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
Exit Sub
End If
Set db = CurrentDb()
Set rst = db.OpenRecordset("data_Tech")
    strSQL = "SELECT "
     j = 0
     k = 0
    rst.MoveFirst
    For L = 0 To ListFields.ListCount - 1
          If ListFields.Selected(L) Then
          strIN = strIN & "[" & ListFields.Column(0, L) & "] as Field" & k & ","
 
            rst.Edit
            'rst!indexx = k
            rst.Update
            rst.MoveNext
            k = k + 1
        Else
            rst.Edit
            'rst!indexx = Null
            rst.Update
            rst.MoveNext
        End If
           j = j + 1
     Next L
     For L = L To ListFields.ListCount - 1
            strIN = strIN & "null" & ","
     Next L
    
   'str_SQL = str_SQL & strIN
     strFieldList = Left(strIN, Len(strIN) - 1)
     
    strSQL = strSQL & strFieldList & " FROM " & Me!cmb_TQ

    Set QDF1 = db.CreateQueryDef("QForExport", strSQL)
     'db.QueryDefs.delete "QForExport"
     
'=========================================
strSQL = "SELECT * FROM QForExport "
strWhere = "Where field0  IN( "
For i = 0 To SearchListEXp.ListCount - 1
    If SearchListEXp.Selected(i) Then
        strWhere = strWhere & "'" & SearchListEXp.Column(0, i) & "', "

   End If
Next i
strWhere = Left(strWhere, Len(strWhere) - 2) & ");"
strSQL = strSQL & strWhere
Set QDF2 = CurrentDb.CreateQueryDef("qryMyQuery", strSQL)
'===========================================================================
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qryMyQuery", curPath, , "معلمين ابتدائي"
 'DoCmd.OutputTo acOutputQuery, "qryMyQuery", acViewPreview
'DoCmd.DeleteObject acQuery, "qryMyQuery"
'DoCmd.DeleteObject acQuery, "QForExport"
'========format ExcelFile
FormatExcelOut (curPath)
'=======================
      Set xlApp1 = CreateObject("Excel.Application")
      xlApp1.Visible = False   'True
    
    Set xlWB1 = xlApp1.Workbooks.Open(curPath)
'    Set xlWs1 = xlWB1.Worksheets("qryMyQuery")
    
     ' xlWs1.DisplayRightToLeft = True
    
  xlWB1.Save
  xlApp1.Quit
    Set xlWs1 = Nothing
    Set xlWB1 = Nothing
    Set xlApp1 = Nothing
    Set db = Nothing
    Set td = Nothing
Beep
MsgBox "لقد تم تصدير البيانات بنجاح",

 

[ahmed_204079]

تمام متشكر يابو جودي علي مجهوك انتظرتك كتير 

الحمد لله حليت كل مشاكل الكود وخلصت البرنامج 

وسسلمت الميزانية 

[ابو جودي]

منذ ساعه, ahmed_204079 said:

تمام متشكر يابو جودي علي مجهوك انتظرتك كتير 

الحمد لله حليت كل مشاكل الكود وخلصت البرنامج 

وسسلمت الميزانية 

اولا بارفو  شاطر والله انك بتحاول وتعافر وتشغل دماغك

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

اما اللى بيجى سهل بيروح اسهل ما بيجى

 

انا اسف جدا جدا جدا لحضرتك والله كنت تعبان والعلاج بتاعى مش موجود سامحنى ع التأخير بس فعلا الموضوع اكبر منى الحمد لله رب العالمين

 

اه نسيت اقول لك 

خليك كريم وبطل بخل

لما تكون كاتب سؤال طالما وصلت للاجابة بتاعته بفضل الله

تضع الاجابة بالاكواد وبالمرفق علشان الكل يتعلم وعدد النوايا مساعدة للغير وعلم ينتفع به ونسأل الله تعالى القبول

[ahmed_204079]

الف مليون سلامة عليك ياغالي ربنا يشفي عنك وويقومك بالسلامة💕

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

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

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

لو ليها حل يبقي عندك انت يابوجودي والف سلامة مره تانية🙋‍♂️

 

 

 

 

 

الميزانية ملف بسيط.accdb

[ahmed_204079]

من اقوال ابوجودي

قد لا أكون 
قد لا أكون الأجمل..
قد لا أكون الأروع..
قد لا أكون الأذكى..
قد لا أكون الأبرع..
ولكن إذا جائنى المهموم أسمع..
وإذا نادنى صاحب الحاجه أنفع..
وحتى إذا حصدت شوكا فسأظل للورد أزرع..
وإذا ماكان الكون واسعا لكم فإن قلبى أوسع..

 

[ابو جودي]

وبعد تقديم الاعتذارا عن التأخير راجيا ان تقبله منى  

اتفضل 

 

انا ظبط لك موضوع الحقول واختيار الحقول من الليست بوكس الاول المصدر الى الليست بوكس الثانى الهدف

حقل المسلسل بيظهر 

مفيش شئ اسمه 

في 6‏/8‏/2024 at 08:29, ahmed_204079 said:

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

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

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

 

 

في 6‏/8‏/2024 at 08:29, ahmed_204079 said:

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

انا مش فاهم قصدك ياريت تصور الشاشة وترفقها يمكن اقدر افهم 

 

الميزانية ملف بسيط.accdb