اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

سامي الحداد

الخبراء
  • Posts

    294
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    1

مشاركات المكتوبه بواسطه سامي الحداد

  1. وعليكم السلام 

    الخطاء هنا

    Exit_cmd_Select_Click:
    
        Call cmd_close_Click
        Exit Sub
        
    err_cmd_Select_Click:
    
        If Err.Number = 1 Then
                
        Else
    
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume Exit_cmd_Select_Click
    
    
    وهذا الصحيح
    
    Exit_cmd_Select2_Click:
    
        Call cmd_close_Click
        Exit Sub
        
    err_cmd_Select2_Click:
    
        If Err.Number = 1 Then
                
        Else
    
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume Exit_cmd_Select2_Click

    وهذا ملفك بعد التعديل

    shady master garage test1 24052023.rar

    • Thanks 1
  2. جرب التالي

    Me.المبلغ_الاجمالي.DefaultValue = Nz(Form_الطالب.LenaT) - Nz(DSum("[دفع]", "نموذج الترحيل اليدوي", "[المعرف]=" & Form_الطالب.المعرف) - Nz(DSum("[mortaghday]", "نموذج الترحيل اليدوي", "[المعرف]=" & Form_الطالب.المعرف), 0))

    واليك الملف ان شاءالله يكون هو المطلوب

    11.accdb

    7 دقائق مضت, Eng.Qassim said:

    وعليكم السلام..

    دوال المجال لاتعمل هكذا..

    11.rar 141.53 kB · 0 downloads

    المعذرة استاذ قاسم لم انتبه لردك كنت اكتب  الرد وانشغلت بالرد على الهاتف 

    • Like 1
  3. السلام عليكم 

    بالاضافة لما تقدم به جميع الاساتذة اليك الحل التالي على حسب فهمي لطلبك.

    يرجى موافاتنا بالنتيجة.

    Private Sub Supplier_NotInList(NewData As String, Response As Integer)
    
        Dim Db As DAO.Database
        Dim Rs As DAO.Recordset
        Dim Msg As String
    
        Msg = " " & NewData & "  المورد  " & Supplier & vbCr & vbCr & " غير موجود في القائمة " & vbCr & vbCr
        Msg = Msg & "هل تود إضافة هذا المورد ؟"
        If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
            Response = acDataErrContinue
            MsgBox "تم إلغاء عملية الإضافة", vbInformation, "تنبية"
            Supplier = ""
            Exit Sub
        End If
    
        On Error GoTo CancelAddNew
        Set Db = CurrentDb
        Set Rs = Db.OpenRecordset("Table1", dbOpenDynaset)
    
        Rs.AddNew
        Rs![Supplier] = NewData
        Rs.Update
        Response = acDataErrAdded
    
        Rs.Close
        Set Rs = Nothing
        Set Db = Nothing
        Exit Sub
    
    CancelAddNew:
        
        Response = acDataErrContinue
        Set Rs = Nothing
        Set Db = Nothing
        Exit Sub
        
    
    End Sub

    الملف بعد التعديل 

    تحياتي

    رسائل تنبية.accdb

    • Like 1
  4. قد لا يحتوي متغير addPath على مسار ملف صالح. يجب عليك التحقق من أن قيمة addPath هي مسار ملف صالح وأن الملف موجود في هذا الموقع.

    قد لا يتم تعيين المتغير المحتوي على المجلد بشكل صحيح. يجب عليك التحقق من أن قيمة containsFolder هو مسار المجلد الصحيح الذي يحتوي على الملف المراد إضافته.

    قد لا يتم تعيين متغير itemToZip بشكل صحيح. يجب عليك التحقق من أن قيمة itemToZip هو اسم الملف الصحيح لإضافته إلى أرشيف zip.

    قد تكون هناك مشكلة في fSource.items.Item ((i)) مقارنة الاسم في حلقة For. يجب عليك التحقق من صحة المقارنة ومن أنه تم العثور على الملف الصحيح المراد إضافته.

    هل البرنامج موجود في فولدر واحد ام يندرج تحت عدة فولدرات ؟ 

  5.   

    من بعد إذن الاستاذ @kkhalifa1960 جزاه الله خيرا

    الاخوة الكرام تم إضافة صائد الاخطاء لكود الاستاذ @kkhalifa1960 للوقوف على نوع الخطأ . لكل الاخوة الذين صادفتهم مشكلة في البرنامج الرجاء إعادة المحاولة وتحديث برنامج الضغط الوين رار ضروري وإعلامنا بالنتيجة.

    تحياتي للجميع

    Sub AddToZip(ByVal zipArchivePath As String, ByVal addPath As String)
        Dim sh As Object
        Dim fSource As Object
        Dim fTarget As Object
        Dim iSource As Object
        Dim sourceItem As Object
        Dim i As Long
        Set sh = CreateObject("Shell.Application")
        Set fTarget = sh.Namespace((zipArchivePath))
        If fTarget Is Nothing Then
            createZipFile zipArchivePath
            Set fTarget = sh.Namespace((zipArchivePath))
            If fTarget Is Nothing Then
                MsgBox "فشل إنشاء ملف مضغوط", vbCritical
                Exit Sub
            End If
        End If
        Dim containingFolder As String
        Dim itemToZip As String
        containingFolder = Left(addPath, InStrRev(addPath, "\"))
        itemToZip = Mid(addPath, InStrRev(addPath, "\") + 1)
        Set fSource = sh.Namespace((containingFolder))
        For i = 0 To fSource.items.Count - 1
            If fSource.items.Item((i)).Name = itemToZip Then
                Set sourceItem = fSource.items.Item((i))
                Exit For
            End If
        Next i
        If sourceItem Is Nothing Then
            MsgBox "فشل العثور على ملف لإضافة ملف مضغوط  ", vbCritical
            Exit Sub
        End If
        On Error Resume Next
        fTarget.CopyHere sourceItem
        If Err.Number <> 0 Then
            MsgBox "فشل في إضافة ملف لضغطه", vbCritical
            Err.Clear
        End If
        On Error GoTo 0
    End Sub

     

     

    • Thanks 1
  6. جرب هذا التعديل و وافنا بالنتيجة

    Private Sub mail_DblClick(Cancel As Integer)
        Dim Msg As String
        
        If IsNull(Mail) Or Len(Mail) = 0 Then
            MsgBox "حقل البريد الإلكتروني فارغ. الرجاء إدخال عنوان البريد الإلكتروني "
            Exit Sub
        End If
        
        Msg = "<div style='direction:rtl; font-family:Consolas, Courier;'>" & _
              " hey " & namecus & "<br>" & _
              "</div>"
        
        Dim O As Outlook.Application
        Dim M As Outlook.MailItem
      
        Set O = New Outlook.Application
        Set M = O.CreateItem(olMailItem)
      
        With M
            .BodyFormat = olFormatHTML
            .HTMLBody = Msg
            '.Body = txt - if you see olformatplain
            .To = Mail
            '.CC="khate9191@gmail.com;khateb91@outlook.com"
            '.BCC="hateeb991@gmail.com"
            .Subject = " new mail " & Now()
            .Display
           '.send
        End With
        
        Set M = Nothing
        Set O = Nothing
    End Sub

    تحياتي

    • Like 1
  7. 1 ساعه مضت, kkhalifa1960 said:

    الأخوة همتكم معي لاكتشاف الخطأ أو ترتيب الكود لأني مقدر أكتشفه  لأنه يعمل عندي !!!!!!!!!!!!!:wallbash:

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

    أحسنت وبارك الله فيك اخي @kkhalifa1960

    • Like 1
    • Thanks 1
  8. وعليكم السلام 

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

    Private Sub mail_DblClick(Cancel As Integer)
     Dim Msg As String
        
        If Len(Mail) = 0 Then
            MsgBox "حقل البريد الإلكتروني فارغ. الرجاء إدخال عنوان البريد الإلكتروني "
            Exit Sub
        End If
        
        Msg = "<div style='direction:rtl; font-family:Consolas, Courier;'>" & _
              " hey " & namecus & "<br>" & _
              "</div>"
        
        Dim O As Outlook.Application
        Dim M As Outlook.MailItem
      
        Set O = New Outlook.Application
        Set M = O.CreateItem(olMailItem)
      
        With M
            .BodyFormat = olFormatHTML
            .HTMLBody = Msg
            '.Body = txt - if you see olformatplain
            .To = Mail
            '.CC="khate9191@gmail.com;khateb91@outlook.com"
            '.BCC="hateeb991@gmail.com"
            .Subject = " new mail " & Now()
            .Display
           '.send
        End With
        
        Set M = Nothing
        Set O = Nothing
    End Sub

    تحياتي

  9. السلام عليكم  

    بالاضافة لما تفضل بة اساتذتي الكرام جرب تغير هذه الاسطر . و وافنا بالنتيجة

    Dim strInvoiceID As String
    
    Set rsFatora = db.OpenRecordset("SELECT * FROM tblFatora WHERE FatoraId <> '" & strInvoiceID & "'")
    Set rsHaraka = db.OpenRecordset("SELECT * FROM tblHaraka WHERE Fatora_id <> '" & strInvoiceID & "'")
    

    بالتوفيق

    • Like 1
  10. اخي العزيز @العبيدي رعد

    2 ساعات مضت, العبيدي رعد said:

    العفو  الخلط بالكيبورد   اقصد  جدول  user&pass  ايضا  ...  هل  احذفهما  من  البرنامج ؟  
    وسؤالي  كيف  أحدد  الصلاحيات  ابتداءا  ؟  وعند  دخولي  للبرنامج  عن  طريق  الفورم   كيف  سيتعرف  عن  صاحب  الصلاحيات لنموذج  الادمن ؟

    الجدول user&pass كان في ملفك من الاساس

    تحديد الصلاحيات يتم عن طريق دخول الادمن من نموذج تسجيل الدخول او الجدول ثم اعطاء كل الصلاحيات للنماذج وتفعيل كل الخانات  ما عدا  Button Disable. ضروري ان يكون الزر غير مفعل

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

    منذ ساعه, العبيدي رعد said:

    @سامي الحداد  السلام عليكم

    أخي  العزيز  .. عرفت الادمن  من جدول  الصلاحيات  ولكن يظهر لي خطأ في الكود  عندما  اريد  الدخول الى الصفحة الرئيسية  main

    وأرفق صور توضيحية للجدول  والخطأ  الذي  يحث  في  حدث    onopen  للنموذج 

    جدول صلاحيات.PNG

    خطأ2.PNG

    بالنسبة لهذا الخطاء هو انه  زر الامر Command0  غير موجود في هذا  القورم . 

    وهناك ايضا خطاء انه تم تفعيل زر Button Disable لان الشخص ابو ايمان له كل الصلاحيات إذن يجب إلغاء هذا الزر وعدم تفعيله اذا كان الادمن.

    سارفق لك نفس ملفك الاول والذي عملت عليه واعطيت سامي صلاحية الادمن وكلمة المرور 555  انظرا جيدا كيف تم العمل واكمل .

    واي استفسار بخدمتكم . ربما أتاخر في الاجابة بسببت فرق التوقيت 

    تحياتي

    صلاحيات.accdb

  11. حياك الله اخي الدكتور محمد

    اليك ثلاثة ملفات باكواد مختلفة وجميعها تعمل بشكل صحيح مع الويندوز 10 والاوفيس 2019 .

    وكما ذكرت سابقا لن استطع التطبيق على الويندوز 7 والاوفس 2010 لانني لا املكهم.

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

    وكنت أتمنى من الاخ @tamer.murad صاحب الموضوع ان  يبدي رأيه أيضا. 

    تحياتي لشخصكم الكريم 

    1275940712_AllVer.MediaSoft.rar

    • Like 1
  12. 8 ساعات مضت, سامي الحداد said:

    كلا استاذي الكريم محمد هذا الكود يختلف عن السابق انظر للاكواد هنا في المشاركتين. 

    8 ساعات مضت, سامي الحداد said:
    Dim formsDictionary As New Scripting.Dictionary
        formsDictionary.ADD ChrW(&H62A), "frmCompany"
        formsDictionary.ADD ChrW(&H622), "frmSystemUserData"
        formsDictionary.ADD ChrW(&H643), "frmPassword"
        formsDictionary.ADD ChrW(&H62C), "frmDeveloper"
    
    4 ساعات مضت, الحلبي said:

    اعانك الله علينا ودام عليك نعمة مساعدة الاخرين

     بخدمتكم استاذي الكريم 

    تحياتي

  13. تفضل اخي 

    شوف التعديل هل هو المطلوب؟

    Option Compare Database
    Option Explicit
    Dim strSQL As String
    Dim rs As DAO.Recordset
    Dim PreviousSearchText As String
    Private Sub CmdClear_Click()
    Me.TEXT_CHERCHE = ""
    Me.Query_no_subform.Form.Filter = ""
    Me.Query_no_subform.Form.FilterOn = False
    Me.Query_no_subform.Form.Requery
    End Sub
    '1 OK
    Private Sub TEXT_CHERCHE_Change()
        If Me.TEXT_CHERCHE.Text = "" Then
           Me.Query_no_subform.Form.Filter = ""
           Me.Query_no_subform.Form.FilterOn = False
        Else
            Dim strSQL As String
            strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34)
            Me.Query_no_subform.Form.Filter = strSQL
            Me.Query_no_subform.Form.FilterOn = True
            
            If Me.Query_no_subform.Form.Recordset.RecordCount = 0 Then
               MsgBox "لم يتم العثور على سجلات للنص المدخل", vbInformation, "تنبيه"
              End If
        End If
    End Sub
    
      
      Private Sub cmdPrintPreview_Click()
        Me.TEXT_CHERCHE.SetFocus
    
        strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34)
        ' Open the report in print preview mode
        DoCmd.OpenReport "MyReport", acViewPreview, , strSQL
    End Sub
    
    Private Sub TEXT_CHERCHE_KeyDown(KeyCode As Integer, Shift As Integer)
      If KeyCode = 27 Then
        Me.TEXT_CHERCHE.Text = ""
        Me.Query_no_subform.Form.Filter = ""
        Me.Query_no_subform.Form.FilterOn = False
    
      End If
    End Sub
    

    تحياتي

    my PR.accdb

    • Like 1
  14. بالاضافة لما تفضل به الاستاذ @kkhalifa1960 جزاه الله خيرا

    اليك مشاركتي

    Option Compare Database
    Option Explicit
    Dim strSQL As String
    Dim rs As DAO.Recordset
    Private Sub CmdClear_Click()
    Me.TEXT_CHERCHE = ""
    Me.Query_no_subform.Form.Filter = ""
    Me.Query_no_subform.Form.FilterOn = False
    
    End Sub
    Private Sub TEXT_CHERCHE_Change()
        
    
    strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34)
        Me.Query_no_subform.Form.Filter = strSQL
        Me.Query_no_subform.Form.FilterOn = True
    
        Set rs = Me.Query_no_subform.Form.Recordset
        If (rs.RecordCount <> 0) Then
        rs.MoveFirst
        Do Until rs.EOF
            rs.Edit
            rs![oui/non] = True ' change "chkBoxFieldName" with the actual name of your checkbox field
            rs![date_à_regler] = Date ' change "dateFieldName" with the actual name of your date field
            rs.Update
            rs.MoveNext
        Loop
    Else
            MsgBox "السجل المطلوب تم التحقق منه سابقا بتاريخ "
    End If
    
    End Sub
    
    Private Sub cmdPrintPreview_Click()
        Me.TEXT_CHERCHE.SetFocus
    
        strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34)
        ' Open the report in print preview mode
        DoCmd.OpenReport "MyReport", acViewPreview, , strSQL
    End Sub
    

    وهذا ملفك بعد التعديل. هل هو المطلوب؟

    بالتوفيق

     

    my PR.accdb

    • Like 1
  15. 21 ساعات مضت, الحلبي said:

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

    هل ممكن ان ترفق ملفك حتى نرى اين المشكلة ؟

    وجرب هذا التعديل  

    Private Sub Form_Load()
        Dim OldLong As Long
        Dim nodX As Node
        Set nodX = TreeView1.Nodes.ADD(, , "R", "أعدادات النظام", 3)
        Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C1", "بيانات الشركة", 2)
        Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C2", "بيانات مستخدمي النظام", 5)
        Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C3", "كلمات المرور", 1)
        Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C4", "بيانات المطورين", 4)
        nodX.EnsureVisible
        OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE)
        SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL
        InvalidateRect hwnd, 0, False
        
        Dim formsDictionary As New Scripting.Dictionary
        formsDictionary.ADD ChrW(&H62A), "frmCompany"
        formsDictionary.ADD ChrW(&H622), "frmSystemUserData"
        formsDictionary.ADD ChrW(&H643), "frmPassword"
        formsDictionary.ADD ChrW(&H62C), "frmDeveloper"
    
    End Sub
    Private Sub TreeView1_Click()
       
        Dim strFormName As String
        Dim formsDictionary As New Scripting.Dictionary
        formsDictionary.ADD "بيانات الشركة", "frmCompany"
        formsDictionary.ADD "بيانات مستخدمي النظام", "frmSystemUserData"
        formsDictionary.ADD "كلمات المرور", "frmPassword"
        formsDictionary.ADD "بيانات المطورين", "frmDeveloper"
        strFormName = TreeView1.SelectedItem.Text
        If formsDictionary.Exists(strFormName) Then
            DoCmd.OpenForm formsDictionary(strFormName)
        Else
            MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه"
        End If
    
    
    End Sub

     

    21 ساعات مضت, الحلبي said:

    جزاك الله كل خير ـ وبارك الله فيك وفى علمك ـ وزادك الله من رزقه وعلمه

    ولك بمثل ما دعوت أخي الدكتور محمد

    تحياتي

    • Like 1
  16. 7 دقائق مضت, العبيدي رعد said:

    السلام  عليكم

    ماهو  دور  الجدولين      tblsecurtytype

    و    عسثق&حشسس

    هاي ما اعرفها   (و    عسثق&حشسس) 

    بالنسبة ل tblsecurtytype  فهذا عملته لبرنامج ثاني حيث الدخول للبرنامج يتم عن طريق التاكد من المستخدم . 

  17. 2 ساعات مضت, العبيدي رعد said:

    هذا  حدث  واحد   يوضع  في  كل  فورم  ندخل  عليه  أم  في  الفورم  الرئيسي              main

    نعم اخوي رعد يضع في كل فورم  هذا الكود.

    Private Sub Form_Open(Cancel As Integer)
    Call UserPermission(Me, GetUserLoginID())
    End Sub

    وإذا كان الفورم فيه ازرار تريدها ان تكون غير مفعلة تضع باقي الكود فيصبح كالاتي.

    Private Sub Form_Open(Cancel As Integer)
    Call UserPermission(Me, GetUserLoginID())
    
    If TempVars!IsFormOpened = 1 Then
        Exit Sub
    Else
    
        Call DisableButton(Me, GetUserLoginID, Me.cmdSetPermission, هنا تضع اسم الزر مثلا Me.Addnew) 
    End If
    End Sub

    حياك الله 

    28 دقائق مضت, العبيدي رعد said:

    السلام عليكم

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

    تستطيع ان تبدا من الجدول نعم فقط لك كمسؤول . ومن ثم عليك إغلاق كل الابواب وعدم السماح بالدخول من الخلف.

     

     

  18. اخي واستاذي الحبيب @الحلبي

    من المحتمل أن تكون المشكلة التي تواجهها متعلقة بالطريقة التي يتم بها التعامل مع النص العربي في الإصدار الأقدم من Office و Windows. في Office 2010 و Windows 7 ، يكون ترميز الأحرف الافتراضي للنص هو ANSI ، والذي قد لا يدعم جميع أحرف Unicode ، بما في ذلك الأحرف العربية. وللتغلب على هذه المشكلة هناك طريقتين الحل الاول هو تغيير ترميز الأحرف الافتراضيه للملفات النصية ، وسوف نغير ترميز الأحرف الافتراضي إلى UTF-8

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

    Option Explicit
    
    #If Win64 Then
        Private Declare PtrSafe Function SetFileApisToOEM Lib "kernel32" () As Long
        Private Declare PtrSafe Function SetFileApisToANSI Lib "kernel32" () As Long
    #Else
        Private Declare Function SetFileApisToOEM Lib "kernel32" () As Long
        Private Declare Function SetFileApisToANSI Lib "kernel32" () As Long
    #End If
    
    Private Sub TreeView1_Click()
        Dim strFormName As String
        Dim formsDictionary As New Scripting.Dictionary
        
        SetFileApisToANSI
        System.PrivateProfileString("", "", "")
        System.PrivateProfileString("", "", "")
        SetFileApisToOEM
        System.PrivateProfileString("", "", "")
        System.PrivateProfileString("", "", "")
    
        formsDictionary.Add "بيانات الشركة", "frmCompany"
        formsDictionary.Add "بيانات مستخدمي النظام", "frmSystemUserData"
        formsDictionary.Add "كلمات المرور", "frmPassword"
        formsDictionary.Add "بيانات المطورين", "frmDeveloper"
    
          strFormName = TreeView1.SelectedItem.Text
          If formsDictionary.Exists(strFormName) Then
          DoCmd.OpenForm formsDictionary(strFormName)
    Else
          MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه"
    End If
    End Sub

    عذرا اخي الدكتور محمد لم اجرب الكود لانني لا املك الويندوز 7 والاوفيس 2010 . بانتظار تجربتك.

    تحياتي 

  19. 1 ساعه مضت, محمد احمد لطفى said:

    أستاذى @سامي الحداد
    جزاك الله خيراً
    حضرتك حذفت السطر الاول يدوى ولا من خلال اكسيس أرجو الافادة

    سؤال ممكن اسماء الحقول تبدأ من السطر التانى فى اكسيس 
     

    تم حذف السطر الاول من ملف الاكسس بواسطة كود من الاكسس وهذا هو الكود.

    Sub DeleteFirstRow()
        Dim xlApp As Excel.Application
        Set xlApp = New Excel.Application
    
        Dim xlWorkbook As Excel.Workbook
        Set xlWorkbook = xlApp.Workbooks.Open("C:\xxxxx\0125.xls")غير مسار الملف   
    											
        xlWorkbook.Sheets(1).Activate
    
        Dim firstRow As Excel.Range
        Set firstRow = xlApp.ActiveSheet.Range("A1:IV1")
    
        firstRow.Delete
    
        xlWorkbook.Save
        xlWorkbook.Close
    
        xlApp.Quit
    End Sub

    بالتوفيق

    • Like 1
    • Thanks 1
  20. بالاضافة لما تفضل به الاساتذة اليك مشاركتي

    Sub CopyTableStructure()
       
          If Not TableExists("tblOld") Then
            MsgBox "Table 'TblOld' does not exist in the current database."
            Exit Sub
    End If
    
        Dim strPath As String
        strPath = CurrentProject.FullName
        DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, "tblOld", "TblNew", True
    
    
    End Sub
    
    Function TableExists(tblName As String) As Boolean
        TableExists = (CurrentDb.TableDefs(tblName).Name = tblName)
    End Function
    

     

    testdate4.mdb

    • Thanks 1
  21. منذ ساعه, محمد احمد لطفى said:

    أستاذى @ابو البشر
    هذا المرفق

    وجزاك الله خيراً

    0125.xls 32 kB · 2 downloads

    مثل ما تفضل به الاستاذ @ابو البشر والكود له جزاه الله خيرا .

    انا فقط حذفت السطر الاول من الاكسل حسب طلبك  جرب ووافينا بالنتيجة .

     

    testdate4.rar

    • Thanks 1
×
×
  • اضف...

Important Information