نجوم المشاركات

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

استبدل الدالة السابقة بالتالي :- Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & IIf(formatType = "PDF", ".pdf", ".doc") Dim filePath As String With Application.FileDialog(2) .Title = "اختر موقع الحفظ" .AllowMultiSelect = False .InitialFileName = fileName If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub End If End With DoCmd.OutputTo acOutputReport, namerpts, IIf(formatType = "PDF", acFormatPDF, acFormatRTF), filePath, True, , , acExportQualityPrint End Sub أما فيما يتعلق بالتصدير كملف Excel فأعتقد أنه قد يختلف عما يدور في خيالك وله ضبط خاص .

معلمي القدير وأستاذنا الجليل @ابوخليل :- في الدالة Now ، لن ينجح الأمر والسبب باعتقادي هو احتواء التنسيق على حروف غير مسموح بها كإسم لملف أو مجلد = " : " وهو النقطتين هذا رأيي ما لم يكن هناك سبب آخر ، حيث أنه في التنسيق المصاحب للدالة Now في الأكواد تم ضبط التنسيق بإزالة النقطتين . لم انتبه لرد الأستاذ @محمد احمد لطفى ، فلم يكن الرد موجوداً قبل ردي واعتقد أنني كنت في الصفحة مسبقاً ولم أعمل تحديث

ومشاركة مع الأستاذ محمد لطفي ، قمت بإنشاء دالة واحدة يتم استدعائها في اي من الزرين لتنفيذ المهمة حسب الزر . Private Sub أمر17_Click() ExportReport "PDF", Me.Namea.Value End Sub Private Sub أمر18_Click() ExportReport "RTF", Me.Namea.Value End Sub Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & IIf(formatType = "PDF", ".pdf", ".doc") Dim filePath As String filePath = CurrentProject.Path & "\" & fileName DoCmd.OutputTo acOutputReport, namerpts, IIf(formatType = "PDF", acFormatPDF, acFormatRTF), filePath, True, , , acExportQualityPrint End Sub ملفك بعد التعديل ( شريط طباعة.accdb )

السلام عليكم حياكم الله اساتذتنا الافاضل واعضاء منتدانا الشامخ طبتم وطابت ايامكم .. أسأل الله أن تكونوا في أتم الصحة والعافيه المطلوب كالتالي: في نموذج prin الخاص بشريط الطباعة عند الضغط على زر ( حفظ Word ) أو زر ( حفظ pdf ) يتم تصدير الملف الناتج باسم ياخذ قيمته من ( متغير أو حقل الموجود في النموذج Namea ) والتاريخ والوقت مثال: محمد طاهر 2024/10/14-08:40ص.pdf مع العلم أن التقرير الحالي يتم تصدير باسم التقرير الاساسي (rpt_rensen) بالرغم تغير اسماء الاشخاص وهذه مشكلة مرفق ملف للتعديل علية شريط طباعة.accdb

بارك الله فيك استاذنا الغالي @Foksh😚 قمت بتجربة الملف يعمل بنجاح ساقوم بنقل الاكواد لملفي الخاص واقوم بتجربته جزاك الله عني خيرا اسأل الله ان يدخلك الجنة الفردوس الاعلى ووالديك وذريتك واهلك أستاذي أن سمحت اتمنى ان تخبرني باسمك الاول والاخير حتى ادعوك لك بضهر الغيب أعتذر من الاموجي يرفض الحذف

تفضل يا صديقي ،، التعديل الجديد :- Private Sub ExportReport(formatType As String, userName As String) On Error Resume Next Dim fileName As String Select Case formatType Case "PDF" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".pdf" Case "RTF" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".doc" Case "Excel" fileName = userName & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh nn AM/PM") & ".xls" End Select Dim filePath As String With Application.FileDialog(2) .Title = "اختر موقع الحفظ" .AllowMultiSelect = False .InitialFileName = fileName If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub End If End With Dim outputFormat As Variant Select Case formatType Case "PDF" outputFormat = acFormatPDF Case "RTF" outputFormat = acFormatRTF Case "Excel" outputFormat = acFormatXLS End Select DoCmd.OutputTo acOutputReport, namerpts, outputFormat, filePath, True, , , acExportQualityPrint End Sub الملف بعد التعديل :- ( شريط طباعة.accdb )

من باب مشاركة اخي @Foksh واثراء الموضوع :::: جرب هذا DateDiff("m", date1, date2) * 30 + (Day(date2) - Day(date1))

قمت بتغيير النهج عن السابق ، ويبدو انني قد اغفلت عن تجربة زري الـ Pdf و الـ Rtf . 🤦 حالما اصل المنزل سأقوم بالتعديل إن شاء الله

في نموذج التصدير تسمية الازرار = حفظ وورد ، حفظpdf فأنا اتكلم من هذا المنطلق .. فالحفظ يختلف تماما عن عملية تصدير فقط اذا الملفات غير مهمة ( ويمكن التصدير في اي وقت) .. ولست بحاجة الى الرجوع لها مستقبلا .. فلا مشكلة سر في طريقك

أستاذى @ابوخليل عند استخدم الدالة NOW فإن وجود الفواصل (/ و : سيؤدي إلى عدم إمكانية حفظ الملف، نظرًا لأن نظام الملفات لا يسمح بهذه الرموز في أسماء الملفات

عندي استفساران الأول لأخوتي واحبتي الخبراء الى تكفي الدالة NOW لوحدها بدون تنسيقات مصاحبة .. لأن التنسيقات موجودة بها فعلا ... انا لم اجرب فقط استفسار الثاني لصاحب الموضوع : لماذا تفتح مربع الحوار لحفظ الملفات .. عادة الحفظ يكون في مجلد محدد مسبقا .. وهذا المجلد سيعرفه اكسس فيما لو اردنا مستقبلا الطباعة او الفتح غالبا مربع الحوار نحتاجه عند الجلب

أعتقد أنه يمكنك ذلك ، من خلال الكود التالي ، قم بالتجربة والرجوع بالنتيجة ( لأنني لا استوعب فكرة أم تكون السنة 360 ، أو اعتبار أن جميع الشهور 30 يوم ) Function DateDiff360(date1 As Date, date2 As Date) As Long Dim monthsDiff As Long monthsDiff = DateDiff("m", date1, date2) Dim daysDiff As Long daysDiff = DateDiff("d", DateAdd("m", monthsDiff, date1), date2) DateDiff360 = monthsDiff * 30 + daysDiff End Function ويتم الإستدعاء كالتالي :- Dim daysDifference As Long daysDifference = DateDiff360([Date1], [Date2])

تفضل pdf Dim fileName As String fileName = Me.Namea & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh mm AM/PM") & ".pdf" DoCmd.OutputTo acOutputReport, namerpts, acFormatPDF, fileName, True, , , acExportQualityPrint Word Dim fileName As String fileName = Me.Namea & " - " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh mm AM/PM") & ".doc" DoCmd.OutputTo acOutputReport, namerpts, acFormatRTF, fileName, True, , , acExportQualityPrint شريط طباعة.rar

تفضل بيانات الطلبة4.rar

السلام عليكم اذاكانت الملفات المرتبطة عددها بسيط استخدم الطريقة اليدوية التالية فتح الملف الرئيسي: افتح ملف Excel الرئيسي الذي يحتوي على الروابط إلى الملفات الأخرى. تحرير الروابط: اذهب إلى علامة التبويب "البيانات" (Data) في الشريط. اضغط على "تحرير الروابط" (Edit Links) التي توجد عادة في مجموعة "الاتصالات" (Connections). تغيير مصدر الروابط: ستظهر لك نافذة تحتوي على جميع الروابط الموجودة في الملف. حدد الروابط التي تحتاج إلى تحديث، ثم اضغط على "تغيير المصدر" (Change Source). اختيار الموقع الجديد: اختر الملفات من الموقع الجديد الذي تم نقلها إليه. تحديث الروابط: بعد اختيار الملفات، اضغط على "موافق" لتحديث الروابط إلى الموقع الجديد. اذ كانت الروابط كثيرة فاستخدم الكود التالى Sub UpdateLinks() Dim OldLink As String Dim NewLink As String Dim LinkArray As Variant Dim i As Integer ' الرابط القديم OldLink = "C:\المسار_القديم\" ' الرابط الجديد NewLink = "C:\المسار_الجديد\" LinkArray = ActiveWorkbook.LinkSources(Type:=xlExcelLinks) If Not IsEmpty(LinkArray) Then For i = LBound(LinkArray) To UBound(LinkArray) If InStr(LinkArray(i), OldLink) > 0 Then ActiveWorkbook.ChangeLink Name:=LinkArray(i), NewName:=Replace(LinkArray(i), OldLink, NewLink), Type:=xlExcelLinks End If Next i End If MsgBox "تم تحديث الروابط بنجاح!", vbInformation End Sub قم بتعديل المسارات (OldLink و NewLink) حسب الموقع القديم والجديد للملفات.

السلام عليكم - أهل العلم والخبرة - اضافة الى علمهم - تواضعهم واهتمامهم بمساعدة الاخرين وكلمتك واي إستفسار سنكون دائما سعداء بمساعدتك والله هذه الكلمات اسعدني - كما سعدتني بالحل والكود الرائع الذي هو المطلوب جزاك الله خير

انظر هل هذا مطلوبك ؟ بيانات الطلبة3.rar

أخي @صباح2024 إدا كنت قد إستوعبت طلبك سنقوم بتعديل الكود بطريقة مختلفة لنتمكن من تنفيد المطلوب بشكل دقيق لان دمج الاكواد على Private Sub Worksheet_Change(ByVal Target As Range) والإشتغال عليها مباشرة من شأنه أن يسبب لك عدة مشاكل خاصة انك ترغب بتحديث البيانات عند كل تغيير على اي خلية لنفترض أنك قمت باسـتدعاء اي اسم مثلا من الطبيعي ان البيانات السابقة مختلفة بمجرد استدعائها سيتم نسخها للاعمدة الخاصة بالاسم الدي تم اختياره مما سيسبب لك تلف وتعارض في البيانات اسف على الإطالة لاكن لابد من توضيح الفكرة ( اليك ما تم الإشتغال عليه) 1) جلب البيانات من ورقة السجل الى ورقة استدعاء بشرط الإسم 2) تحديث البيانات عند التغيير في أي خلية من الخلايا التي تم تمييزها باللون الأصفر على ورقة استدعاء على الأعمدة المناسبة في ورقة السجل مع مراعات الإسم 3) تم اظافة كود لإنشاء قائمة منسدلة ديناميكية بالأسماء الفريدة من العمود B ( ورقة السجل) بداية من الصف 2 تلقائيا في خلية الإسم (B6) ورقة استدعاء الأكواد المستخدمة : Public Property Get WS() As Worksheet Set WS = Sheets("استدعاء") End Property Public Property Get dest() As Worksheet Set dest = Sheets("السجل") End Property ' خلية الإسم Public Function Clé() As String Clé = WS.Range("B6").Value End Function 'نطاق البحث Public Function rng() As Range Set rng = dest.Range("B2:B" & dest.Cells(dest.Rows.Count, 2).End(xlUp).Row) End Function '======================== ' جلب البيانات من ورقة السجل إلى ورقة "استدعاء" Sub Fetch_data() Dim data As Variant, i As Long, tmp As Range Application.ScreenUpdating = False On Error GoTo CleanExit Set tmp = rng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole) If tmp Is Nothing Then MsgBox "لم يتم العثور على الإسم" & " : " & Clé & " في السجل", vbExclamation Exit Sub End If For i = 0 To 3 data = dest.Range(tmp.Offset(0, 1 + (i * 9)), tmp.Offset(0, 9 + (i * 9))).Value WS.Range("A" & (9 + (i * 3)) & ":I" & (9 + (i * 3))).Value = data Next i CleanExit: Application.ScreenUpdating = True End Sub '======================== ' تحديث البيانات من ورقة استدعاء الى ورقة السجل Sub Update_data() Dim tmp As Range, cnt() As Variant, OnRng As Range Dim ColArr() As Long, j As Long, i As Long Set OnRng = rng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole) If OnRng Is Nothing Then MsgBox "لم يتم العثور على الإسم" & " : " & Clé & " في السجل", vbExclamation Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim Irow As Long Irow = OnRng.Row ReDim ColArr(0 To 35) For j = 0 To 35 ColArr(j) = j + 3 Next j ReDim cnt(UBound(ColArr)) For i = 0 To UBound(cnt) cnt(i) = WS.Cells(9 + (i \ 9) * 3, 1 + (i Mod 9)).Value Next i For i = 0 To UBound(ColArr) If dest.Cells(Irow, ColArr(i)).Value <> cnt(i) Then dest.Cells(Irow, ColArr(i)).Value = cnt(i) End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub '======================== ' إضافة قائمة منسدلة بالأسماء المتوفرة في ورقة "السجل" Sub Add_listeDéroulante() Dim lr As Long, arr() As String, r As Range, i As Long Dim cnt As New Collection, Names As Range lr = dest.Cells(dest.Rows.Count, 2).End(xlUp).Row On Error Resume Next For Each r In rng If r.Value <> "" Then cnt.Add r.Value, CStr(r.Value) End If Next r On Error GoTo 0 If cnt.Count = 0 Then Exit Sub ReDim arr(1 To cnt.Count) For i = 1 To cnt.Count arr(i) = cnt(i) Next i Set Names = WS.Range("B6") With Names.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(arr, ",") .IgnoreBlank = True: .InCellDropdown = True: .ShowInput = True: .ShowError = True End With End Sub وفي حدث ورقة استدعاء Private Sub Worksheet_Activate() Add_listeDéroulante End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim Clé As Range, cntArr As Range Set Clé = WS.Range("B6") If Clé.Value = "" Then Exit Sub If Target.Address = Clé.Address Then On Error GoTo ErrorHandler Fetch_data Exit Sub End If ' عناوين الخلايا المستهدفة Set cntArr = Me.Range("A9:I9, A12:I12, A15:I15, A18:I18") If Not Intersect(Target, cntArr) Is Nothing Then On Error GoTo ErrorHandler Update_data Exit Sub End If Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description On Error GoTo 0 End Sub وأي إستفسار سنكون دائما سعداء بمساعدتك تحويل التغييرات من شيت الاستدعاء الى شيت السجل.xlsm

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

وعليكم السلام ورحمة الله تعالى وبركاته تفضل أخي تم تنفيد طلبك بنفس الفكرة إستخراج الأرقام المكررة مع ترحيل التقرير لورقة2 يتضمن إسم الصنف - القيمة المكررة - عدد التكرارات Const Item As Long = 2 ' تحديد أدنى عدد للتكرارات المطلوبة Sub Find_DuplicatedNumbers() Dim WS As Worksheet, dest As Worksheet Dim CodeArr() As Variant, f() As Variant, code As Variant Dim tmp As Object, ligne As Long, a As Long Dim lastRow As Long, i As Long, key As Variant Dim dict As Object, n As Boolean Dim Rng As Range, c As Range, LR As Long Set WS = Sheets("Sheet1") Set dest = Sheets("Sheet2") lastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row On Error Resume Next CodeArr = WS.Range("A3:A" & lastRow).Value f = WS.Range("B3:B" & lastRow).Value Set tmp = CreateObject("Scripting.Dictionary") For i = 1 To UBound(CodeArr, 1) If Not tmp.Exists(CodeArr(i, 1)) Then tmp.Add CodeArr(i, 1), CreateObject("Scripting.Dictionary") End If On Error GoTo 0 If tmp(CodeArr(i, 1)).Exists(f(i, 1)) Then tmp(CodeArr(i, 1))(f(i, 1)) = tmp(CodeArr(i, 1))(f(i, 1)) + 1 Else tmp(CodeArr(i, 1))(f(i, 1)) = 1 End If Next i n = False For Each code In tmp.Keys Set dict = tmp(code) For Each key In dict.Keys If dict(key) >= Item Then n = True Exit For End If Next key If n Then Exit For Next code If Not n Then MsgBox "لا توجد أي تكرارات للقيم", vbInformation: Exit Sub Application.ScreenUpdating = False LR = WS.Cells(WS.Rows.Count, "F").End(xlUp).Row WS.Range("F3:G" & LR).Borders.LineStyle = xlNone dest.Range("A2:C" & dest.Rows.Count).ClearContents WS.Range("F3:G" & WS.Rows.Count).ClearContents dest.Cells(2, 1).Resize(1, 3).Value = Array("كود الصنف", "القيمة المكررة", "عدد مرات التكرار") ligne = 3 a = 3 For Each code In tmp.Keys Set dict = tmp(code) For Each key In dict.Keys If dict(key) >= Item Then WS.Cells(ligne, 6).Value = code WS.Cells(ligne, 7).Value = key ligne = ligne + 1 dest.Cells(a, 1).Resize(1, 3).Value = Array(code, key, dict(key)) a = a + 1 End If Next key Next code LR = WS.Cells(WS.Rows.Count, "F").End(xlUp).Row Set Rng = WS.Range("F3:G" & LR) For Each c In Rng.Rows If Application.WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous End If Next c Application.ScreenUpdating = True MsgBox dest.Name & " تم ترحيل ملخص الأرقام المكررة إلى", vbInformation End Sub الأرقام المكررة.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك استخدام شيئ كهدا Private Sub CommandButton19_Click() 'TEXTBOX1'نسخ الى الحافظة Dim objCpt As New MSForms.DataObject Dim textToCopy As String If TextBox1.Text = "" Then MsgBox "لا يوجد محتوى للنسخ. الرجاء إدخال نص أو رقم أولاً.", 64 Else ' الحصول على النص من TextBox1 textToCopy = TextBox1.Text ' وضع النص في الحافظة objCpt.SetText textToCopy objCpt.PutInClipboard ' MsgBox "تم نسخ النص إلى الحافظة.", vbInformation End If End Sub '************************** Private Sub CommandButton20_Click() Dim objCpt As New MSForms.DataObject Dim textToCopy As String ' الحصول على نص الحافظة On Error Resume Next objCpt.GetFromClipboard textToCopy = objCpt.GetText On Error GoTo 0 ' التحقق مما إذا كانت TextBox1 فارغة If Me.TextBox1.Text = "" Then MsgBox "TextBox1 فارغ. لا يمكن إجراء العملية.", vbExclamation ' التحقق مما إذا كانت الحافظة فارغة ElseIf textToCopy = "" Then MsgBox "الحافظة فارغة. يرجى نسخ نص إلى الحافظة أولاً.", vbExclamation Else ' لصق نص الحافظة إلى TextBox6 Me.TextBox6.Text = textToCopy ' MsgBox "تم لصق النص من الحافظة إلى TextBox6.", vbInformation End If End Sub ولنسخ البيانات من خارج اليوزرفورم او العكس Private Sub CommandButton2_Click() 'TEXTBOX 1 ' لصق في الخلية النشطة If Me.TextBox1.Text = "" Then MsgBox "لا يوجد محتوى للنسخ. الرجاء إدخال نص أو رقم أولاً.", 64 Exit Sub End If ' التحقق من وجود خلية نشطة If activeCell Is Nothing Then MsgBox "لا توجد خلية نشطة. يرجى تحديد خلية أولاً.", 64 Exit Sub End If ' لصق النص من TextBox1 في الخلية النشطة activeCell.Value = Me.TextBox1.Value MsgBox "تم لصق النص في الخلية النشطة.", vbInformation End Sub '***************** Private Sub CommandButton3_Click() 'TEXTBOX 6 ' لصق في الخلية النشطة If Me.TextBox6.Text = "" Then MsgBox "لا يوجد محتوى للنسخ. الرجاء إدخال نص أو رقم أولاً.", 64 Exit Sub End If ' التحقق من وجود خلية نشطة If activeCell Is Nothing Then MsgBox "لا توجد خلية نشطة. يرجى تحديد خلية أولاً.", 64 Exit Sub End If ' لصق النص من TextBox6 في الخلية النشطة activeCell.Value = Me.TextBox6.Value MsgBox "تم لصق النص في الخلية النشطة.", vbInformation End Sub '**************** Private Sub CommandButton21_Click() 'TEXTBOX 1'نسخ ولصق من الخلية النشطة ' التحقق من وجود خلية نشطة If activeCell Is Nothing Then MsgBox "لا توجد خلية نشطة. يرجى تحديد خلية أولاً.", 64 Exit Sub End If ' التحقق من كون الخلية النشطة فارغة If IsEmpty(activeCell.Value) Then MsgBox "الخلية النشطة فارغة. يرجى تحديد خلية تحتوي على بيانات.", 64 Exit Sub End If ' نقل النص من الخلية النشطة إلى TextBox6 Me.TextBox1.Value = activeCell.Value MsgBox "TextBox1" & " " & "تم نقل قيمة الخلية النشطة إلى", vbInformation End Sub '************* Private Sub CommandButton5_Click() 'TEXTBOX 6'لصق في الخلية النشطة ' التحقق من وجود خلية نشطة If activeCell Is Nothing Then MsgBox "لا توجد خلية نشطة. يرجى تحديد خلية أولاً.", 64 Exit Sub End If ' التحقق من كون الخلية النشطة فارغة If IsEmpty(activeCell.Value) Then MsgBox "الخلية النشطة فارغة. يرجى تحديد خلية تحتوي على بيانات.", 64 Exit Sub End If ' نقل النص من الخلية النشطة إلى TextBox6 Me.TextBox6.Value = activeCell.Value MsgBox "TextBox6" & " " & "تم نقل قيمة الخلية النشطة إلى", vbInformation End Sub بما ان ملفك يتضمن عدة اخطاء يجب اصلاحها حاولت فقط وضع الاكواد على Private Sub CommandButton19_Click و Private Sub CommandButton20_Click اليك ملفك مع ملف تم انشاءه لتطبيق عليه بعض الأمثلة يمكنك اختيار ما يناسبك مثال للتجربة.rar

شرح الطريقة : ( حسب المثال المرفق) لدينا نموذج غير منضم يشتمل على عدة حقول ومربع تحرير مصدره جدول معين ونريد عندما نختار اسما معينا من مربع التحرير ان تظهر بقية بيانات السجل اسم مربع التحرير combo1 واسماء الحقول الاخرى txt1 .. txt2.. txt3...... وهكذا ____________________________________________ لنلقي نظرة على محتويات مربع التحرير الداخلية : - ننقر بزر الفأرة الايمن على مربع التحرير ونختار خصائص - نفتح على لسان التبويب : بيانات - ننقر على النقاط الثلاث التي بجانب القيمة : مصدر الصف سيفتح الاستعلام الذي هو مصدر الصف لمربع التحرير لاحظ ان الاستعلام يحتوي على 8 اعمدة وهي الحقول الموجودة في سجل الجدول معرف العمود الاول = صفر معرف العمود الثاني = 1 معرف العمود الثالث = 2 وهكذا ........ هذه المعرفات سنحتاجها عندما نرغب في جلب البيانات من مربع التحرير _________________________________________ الآن نرجع الى النموذج على عرض التصميم وننقر على مربع التحرير بزر الفأرة الايمن - نفتح على لسان التبويب : حدث - ننقر على النقاط الثلاث التي بجانب القيمة : بعد التحديث سيفتح محرر الفيجوال ونلاحظ وجود سطرين جديدين ننسخ الجملة التالية ونلصقها بين السطرين Me.txt1 = combo1.Column(1) Me.txt2 = combo1.Column(2) Me.txt3 = combo1.Column(3) Me.txt4 = combo1.Column(4) Me.txt5 = combo1.Column(5) Me.txt6 = combo1.Column(6) Me.txt7 = combo1.Column(7) (Me.txt1 = combo1.Column(1 تعني : الحقل الاول في النموذج يساوي الحقل1 في مربع التحرير وهكذا ... امل ان يكون الشرح وافيا db.rar

أخي الغالي أولا قم بنسخ الكود أعلاه إلى موديول جديد في محرر الأكواد ثانيا قم بعمل مجلد على البارتسن C باسم Pictures ثالثا ضع صورة داخل المجلد Pictures باسم Penguins متبوعاً بنقطة ثم امتداد الصورة التي نسختها أخيراً اكتب المعادلة بهذا الشكل =INSERTPICTURE("C:\Pictures\Penguins.jpg") ثم اضغط إنتر