كل الانشطه

وضعت يدك على موضع الالم و عالجته

كنت انتظر هذه الجملة 😉 .. هل النتيجة الآن ترضيك ؟؟

أخي جو .. الجزء المسؤول عن ضبط وتنسيق العناوين يقع كما هو واضح في الكود الذي شاركته ، داخل الجزء التالي :- With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, lastCol)) .Interior.Color = RGB(52, 152, 219) .Font.Color = RGB(255, 255, 255) .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With يعني رح نعدل الجزء ونقسمه على 3 مراحل ، لأنه في طلبك انت تريد بعض العناوين بالشكل الطول والباقي سيبقى كما هو في أصله .. لذا جرب ما يلي ، كونك لم ترفق ملف للتجربة وضمان تأكيد الخطوة . فقط استبدل الجزء السابق بالجزي التالي :- ' تنسيق العناوين With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, lastCol)) .Interior.Color = RGB(52, 152, 219) .Font.Color = RGB(255, 255, 255) .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With With xlWS.Range(xlWS.Cells(1, 6), xlWS.Cells(1, lastCol)) .Orientation = 90 'هنا طبعاً زاوية دوران النص ، وتعدلها زل ما بتحب .WrapText = True End With ' وهنا لتحديد ارتفاع الصف الأول حسب أطول عنوان Dim MaxLen As Long Dim TxtLen As Long Dim i As Long For i = 6 To lastCol TxtLen = Len(CStr(xlWS.Cells(1, i).Value)) If TxtLen > MaxLen Then MaxLen = TxtLen Next i xlWS.Rows(1).RowHeight = MaxLen * 6 + 10 على العموم جرب ، وأخبرنا بالنتيجة ..

و عليكم السلام و رحمة الله و بركاته دالة الترحيل كانت موجودة لكن فيها خطأ برمجي (كانت تجلب دائمًا نفس الصنف الأول لكل الصفوف)، بالإضافة لخطأين آخرين: اسم الزبون والتاريخ كانا يسحبان من أعمدة خاطئة. كما أن دالة tafket() المستخدمة للتفقيط غير موجودة أصلاً في الملف (دالة خارجية غير معرفة، لذلك كانت تظهر كخطأ). جرب الملف المرفق الفاتورة(2).xlsx

الخبراء الافاضل هذا الكود ابتكرة الخبير الفاضل خليفة اعادة الله الى المنتدى بالف سلامة Private Sub EXCEL_Click() Dim folderPath As String Dim FilePath As String Dim FileName As String Dim xlApp As Object Dim xlWB As Object Dim xlWS As Object Dim LastRow As Long Dim lastCol As Long Dim NewRow As Long Dim C As Long ' التأكد من اختيار الشهر والسنة If Len(Me.MS_YR & "") = 0 Then MsgBox "الرجاء اختيار الشهر والسنة أولاً", vbExclamation + vbMsgBoxRight, "تنبيه" Me.MS_YR.SetFocus Exit Sub End If ' إنشاء فولدر حفظ النسخ بجوار القاعدة folderPath = CurrentProject.Path & "\Jo_Excel" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath ' اسم الملف مع التاريخ والوقت FileName = "اجمالى شــهر _" & Replace(Me.MS_YR.Value, "/", "-") ' "_" & Format(Now, "yyyy-mm-dd_HH-MM-ss") & ".xlsx" FilePath = folderPath & "\" & FileName ' تصدير الاستعلام On Error Resume Next DoCmd.TransferSpreadsheet _ acExport, _ acSpreadsheetTypeExcel12Xml, _ "Q_Total_Company_Excel", _ FilePath, _ True If Err.Number <> 0 Then MsgBox "خطأ عند التصدير: " & Err.Description Exit Sub End If On Error GoTo 0 ' فتح Excel للتنسيق Set xlApp = CreateObject("Excel.Application") Set xlWB = xlApp.Workbooks.Open(FilePath) Set xlWS = xlWB.Sheets(1) xlApp.Visible = True ' آخر صف وعمود LastRow = xlWS.Cells(xlWS.Rows.count, 1).End(-4162).Row ' xlUp lastCol = xlWS.Cells(1, xlWS.Columns.count).End(-4159).Column ' xlToLeft ' ============================== ' تثبيت الصف الأول بدون Select ' ============================== xlWS.Application.ActiveWindow.SplitRow = 1 xlWS.Application.ActiveWindow.FreezePanes = True ' ============================== ' حدود لجميع الخلايا ' ============================== With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(LastRow, lastCol)).Borders .LineStyle = 1 .Weight = 2 End With ' تنسيق العناوين With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, lastCol)) .Interior.Color = RGB(52, 152, 219) .Font.Color = RGB(255, 255, 255) .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With ' ============================== ' إضافة صف الإجماليات أسفل البيانات ' ============================== NewRow = LastRow + 1 ' دمج أول 4 أعمدة وكتابة "الإجمالي" With xlWS.Range(xlWS.Cells(NewRow, 1), xlWS.Cells(NewRow, 4)) .Merge .Value = "الإجمالي" .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With ' جمع الأعمدة من الخامس فصاعدًا For C = 5 To lastCol xlWS.Cells(NewRow, C).Formula = _ "=SUM(" & xlWS.Cells(2, C).Address & ":" & xlWS.Cells(LastRow, C).Address & ")" Next C ' تنسيق صف الإجمالي With xlWS.Range(xlWS.Cells(NewRow, 1), xlWS.Cells(NewRow, lastCol)) .Font.Bold = True .Font.Size = 12 .Interior.Color = RGB(255, 255, 0) ' حدود خارجية سميكة With .Borders(7) ' Left .LineStyle = 1 .Weight = 4 End With With .Borders(10) ' Right .LineStyle = 1 .Weight = 4 End With With .Borders(8) ' Top .LineStyle = 1 .Weight = 4 End With With .Borders(9) ' Bottom .LineStyle = 1 .Weight = 4 End With ' حدود داخلية أخف With .Borders(11) ' Inside Vertical .LineStyle = 1 .Weight = 2 End With With .Borders(12) ' Inside Horizontal .LineStyle = 1 .Weight = 2 End With End With xlWS.Columns.AutoFit xlWB.save xlWB.Close xlApp.Quit Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing MsgBox "JO_Excel" & " " & " تـم التصدير ... بنجاح مع حفظ النسخة في فولدر ", vbInformation + vbMsgBoxRight End Sub اريد العمود الاول الذى يتحتوى اسماء الشركات ان يكون راسيا كما بالصورة 2 بدل من افقيا كما بالصورة 1 هل هذا ممكن ام لالا

العفو أخي @jo_2010 ..

معلمى الفاضل Foksh شكرا لحضرتك يامبدع الله بجازيك بكل الخير

أعلم أنك قمت بتجربة تغير اسم شركة في الجدول ، ووجدت أن الاسم لم يتغير في التقرير ، لذا الطلب الثاني وهو ضبط اسم الشركة عند تغييرها في الجدول بحيث يتم تعديل الاسم تلقائياً في التقرير .. قمت بتغيير خطة التنفيذ بإجراء بسيط بحيث اعتمدت على أن تكون مربعات النص قيمها مربوطة برقم معرف شركة التأمين . ثم قمت بتغيير أسماء الليبلات لكل شركة تأمين داخل التقرير ليصبح التوحيد بالاسم من Lbl1 إلى Lbl17 . وعليه ولجلب الاسم وبدالة DlookUp استعملت الحلقة التكرارية التالية :- Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) Dim i As Integer For i = 1 To 17 Me.Controls("Lbl" & i).Caption = Nz(DLookup("[Name_comp]", "ALL_Companys", "[ID]=" & i), "") Next i End Sub ملفك بعد تنفيذ الشق الثاني :- JO2026.accdb

هل من حل يا زملاء ؟؟؟

شكرا جزيلا

فكرة جميلة ، وقد تكون من الإضافات التي يمكن للمطور تحوير الفكرة الأساسية من الأداة ليطوعها كيفما يريد . كفكرة القائمة المختصرة المؤقتة او المقرونة بنموذج او تقرير محدد. ولكن بحكم أن الأداة حالياً ما زالت قيد الإنشاء و التطوير ، فقد أقوم بتمكين المستخدم لها بإن يقرر إظهار / إخفاء أشرطة آكسيس الأساسية عند تصديره للشريط بعد بناءه الى قاعدة بياناته الشخصية.

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

انا اشرت الى هذه النقطة ولكن بدون اسهاب وشرح: هنا يأتي دور اسم المستخدم او اسم المجموعة ، اللي عن طريقهم فقط تربط ظهور هذا الشريط. او يظهر في نموذج معين للمسؤول فقط

لفتة جميلة الى هذه الفكرة .. ولكن انظر لهذه النتيجة التي ستمنع ظهور اي خصائص 😉 . هل هذه كافية ؟؟ أم هذه النتيجة :- شكراً لك أخي أبو الحسن

تفضل أخي جو ، محاولتي البسيطة بحيث قمت بإنشاء استعلام آخر باسم Query1 ، وجعلته مصدر للتقرير .. وتركت التنسيق لك كما تريده انت وحاجتك في التصميم . JO2026.accdb

بعد إذن أستاذى عبدالله بشير عبدالله محاولة لفهم المطلوب والمساعدة OK New Microsoft Excel Worksheet (3).xlsx

الملف مفتوح المصدر و ليس به أي كلمات سر

و عليكم السلام ورحمة الله و بركاته هذا الملف من روائع العلامة خبور و هو ملف تعليمي فارغ و لذلك مذكور كلمة السر صراحة و هي 1 و به امكانية حذف الحماية أيضا

السلام عليكم الزملاء الكرام مرفق ملف في الصفحة الاولى المسماة ASD يوجد بيانات شراء مواد باحجام مختلفة وفق رقم فاتورة واحد وفي الصفحة الثانية المسماة FGH يجب ان اجلب البيانات بشرط مطابقة رقم الفاتورة والتاريخ وكمية كل مقاس وتكلفته حاولت استخدام index لم اصل الى النتيجة المطلوبة ارجو المساعدة مع الشكر اوفيسنا.xlsx

السادة الكرام السلام عليكم ورحمة الله وبركاته قمت من فترة بتحميل هذا الملف من المنتدى فورم دخول ولكن نسيت اليوزر والباسورد الرجاء المساعدة في ايجادهما وازاي اضيفه لملف كسيل عندى عشان افتحه بيه فورم دخول.xls

ماشاء الله تبارك الله

كم اليوزر نيم والباسورد لو سمحت

الفكرة جميلة لكن انشاء هذا الريبون واضافته سيتم معها اضافة قائمة ايقونة ملف بالشريط العلوي الاساسي للاكسس و عند النقر عليها سيتمكن المستخدم بالوصول الى خصاىص قاعدة البيانات والتعديل عليها