علي حيدر

بارك الله مشكور استاذ مجدي يونس

عمل جميل براك الله فيك مشكورا

تفضل اخي أبو اسحاق ارجو ات يكون المطلوب my.xlsm

لقد ارسلت لك ملف فيه ما تريد ما عليك الا ايضافته على ملف الخاص بك مع تحياتي

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

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

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

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

احفظ الملف باسم وجعله يعمل مع اكسيل 2007 2010

اخي يوسف المرفق يحتوي على ما تريده من اظهار صورة الموظف فقط عدل على ملفك ما عملته لك ارجو ان يكون المطلوب لان ملفك لا يعمل عندي insertimage.rar

اخي يوسف حميم الملف المرفق لا يعمل حيث يفتح ويغلق احفظه باسم اخر

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

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

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

اخي أبو عبد الواحد لقد تم الترحيل اتمن ان يكون المطلوب مع تحياتي تعديل على الفاتورة - اثاث.rar

اخي من الواضح لم تعدل اكواد الفورم فهي لا تعمل ارسل الملف الأصلي

شكرا لكم لقد حلت واللحمدلله Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As String Dim Destwb As Workbook, Source Dim path As String ThisWorkbook.Save Source = ThisWorkbook.FullName path = "D:\hhh\" If Target.Column = 3 Then lr = Sheets(1).Range("c" & Rows.Count).End(xlUp).Rows.Value End If With Application .ScreenUpdating = False .EnableEvents = False End With Set Destwb = ActiveWorkbook With Destwb .SaveAs Filename:=path & lr, FileFormat:=52 End With Workbooks.Open Source MsgBox "You can find the new file in " & lr Destwb.Close With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

شكرا جزيلا اخي بن علية حاجي على النظر في امري ولكنه اولاً لا يحفظ المتغيرات في الملف الأساسي ثانياً عند وجود اكواد أخرى في مودل وفورم لا يعمل الكود ابداً ارجو االنظر وشكرا على الاهتمام مره اخرى

التعديل على الكود بحيث يبقي الملف الاساسي مفتوح وغلق تلقائي للنسخه المستحدثة الملف مرفق مع الشرح وهذه نسخه عن الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As String Dim Destwb As Workbook Dim path As String path = "D:\hhh\" If Target.Column = 3 Then lr = Sheets(1).Range("c" & Rows.Count).End(xlUp).Rows.Value End If With Application .ScreenUpdating = False .EnableEvents = False End With Set Destwb = ActiveWorkbook With Destwb .SaveAs Filename:=path & lr, FileFormat:=52 .Close SaveChanges:=False End With MsgBox "You can find the new file in " & lr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub نرجو من الاساتذه المشاركه مع خالص تحياتي

التعديل على الكود بحيث يبقي الملف الاساسي مفتوح وغلق تلقائي للنسخه المستحدثة الملف مرفق مع الشرح وهذه نسخه عن الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As String Dim Destwb As Workbook Dim path As String path = "D:\hhh\" If Target.Column = 3 Then lr = Sheets(1).Range("c" & Rows.Count).End(xlUp).Rows.Value End If With Application .ScreenUpdating = False .EnableEvents = False End With Set Destwb = ActiveWorkbook With Destwb .SaveAs Filename:=path & lr, FileFormat:=52 .Close SaveChanges:=False End With MsgBox "You can find the new file in " & lr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub نرجو من الاساتذه المشاركه مع خالص تحياتي SAVEASFILE.rar

هل يوجد حل جزاكم الله خيرا

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

تفضل اخي ارجو ان يكون طلبك هذا الحل Private Sub Workbook_BeforePrint(CancelAs Boolean) motpass = "123!@" call auto_close q1 = InputBox("Please enter your password!") If q1 <> motpass Then MsgBox ("Please enter your valid password!!"), vbCritical Cancel = True call auto_close End If End Sub Sub Auto_Close() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i As Integer kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" Call ToggleCutCopyAndPaste(True) Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

rivate Sub Workbook_BeforePrint(Cancel As Boolean) motpass = "123" call auto_close q1 = InputBox("Please enter your password!") If q1 <> motpass Then MsgBox ("Please enter your valid password!!"), vbCritical Cancel = True call auto_close EndIf End Sub اخي اعزرني على الرد وان تأخر وذلك بسبب انشغالي ارجو ان يكون المطلوب