علي حيدر

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

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

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

my.xlsm

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

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

insertimage.rar

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

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

معلومات2.rar

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

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

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

insertimage.rar

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

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

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

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

اخي أبو عبد الواحد لقد تم الترحيل اتمن ان يكون المطلوب مع تحياتي

تعديل على الفاتورة - اثاث.rar

6 ساعات مضت, abdallh shwaheen said:

مشكور اخي ولكن اين الملف

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

شكرا لكم لقد حلت واللحمدلله

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

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

اخي اعزرني على الرد وان تأخر وذلك بسبب انشغالي ارجو ان يكون المطلوب