محمد يوسف ابو يوسف

اخي lionheart الكود دة شغال 100*100 المطلوب : عند الضغط علي زر حفظ نسخة ملف نصي -اريد الماوس يقف في الشيت الرئيسي Sub MZM16() MyNime = Cells.Text & "d:\" & Cells(1, 2).Text & Nombre & " نسخة" & Format(Now, "-dddd-dd-mm-yyyy-") & "" & ".txt" ActiveWorkbook.SaveAs MyPathDirectory & MyNime, xlTextWindows End Sub

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

اخي lionheart شكراً علي الرد لم افهم هذا الكود وما علاقتة بالمطلوب المطلوب ان لا يتغير اسم الملف الرئيسي اسناء تنفيز الكود المرفق بالمشاركة الالولي انا عند ما اريد حفظ الشيت في ملف منفصل بأسم الخليه b1 بيتم تغير اسم الملف الرئيسي ايضاً وانا مش عايز اسم الملف الرئيسي يتغير جزاكم الله خيراً

اساتذة وخبراء هذا المنتدي الجميل جزاكم الله خيراً اريد بعد الضغط علي الزر وحفظ الملف النصي - يبقي البرنامج الرئيسي كما هو -لا اريد تغير اسم الملف الرئيسي الملف الملف الرئيسي.xlsm

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

اساتذة وخبراء هذا المنتدي : السلام عليكم ورحمة الله اريد مساعدة في تعديل كود حفظ ملف نصي --- المشكلة بعد الحفظ افتح الملف النصي اري الكلام معكوس الملف عمل نسخة ملف نصي.xlsm

اخي نثغةثمسخبف هل تم طلبك ام مذا تريد

اخي نثغةثمسخبف اسف علي التأخير لظروف عملي تفضل مثال 3.xlsm اخبرني بألنتيجه

اخي نثغةثمسخبف تفضل طلبك مثال 3.xlsm اخبرني بالنتيجة

اخي dodo222 تفضل توافق اكسيل 2007-2016.rar

اخي هاشم العلوي طبعاً لعدم توضيحك لطلبك تم عمل الاتي حفظ الصفحة بأسم خليه h5 يتم حفظ الملف علي برتيشن d الملف نموذج كنترول .xlsm اخي هل هذا هو المطلوب اخبرني بالنتيجه

اخي هاشم العلوي مذال طلبك غير واضح---- هل يوجد لديك ملف في مكان معين وتريد الترحيل اليه ام تريد عمل نسخة من شيت معين - في مكان معين من فضلك قم بتوضيح المطلوب 1- اكتب المدي المراد نسخه مثال a1:الي h100 2-المكان المراد النسخ اليه هل هو ملف ام فولدر 3-وعلي اي برتشن تريد النسخ مثال d-a-t-c جزاك الله خيرا

اخي نثغةثمسخبف الكود بعد اضافة الطباعه والمسج اصبح هكذا sub SAVE() Dim Ws As Worksheet: Set Ws = Sheets("صفحة العمل") Dim Sh As Worksheet: Set Sh = Sheets("ترحيل الشراء") LR = Sh.Range("a" & Rows.Count).End(xlUp).Row Sh.Range("a" & LR + 1) = Ws.Range("a2") Sh.Range("a" & LR + 1).Offset(0, 0) = Ws.Range("a12") Sh.Range("a" & LR + 1).Offset(0, 2) = Ws.Range("b11") Sh.Range("a" & LR + 1).Offset(1, 2) = Ws.Range("b12") Sh.Range("a" & LR + 1).Offset(2, 2) = Ws.Range("b13") Sh.Range("a" & LR + 1).Offset(3, 2) = Ws.Range("b14") Sh.Range("a" & LR + 1).Offset(4, 2) = Ws.Range("b15") Sh.Range("a" & LR + 1).Offset(0, 3) = Ws.Range("J3") Sh.Range("a" & LR + 1).Offset(1, 3) = Ws.Range("J4") Sh.Range("a" & LR + 1).Offset(2, 3) = Ws.Range("J5") Sh.Range("a" & LR + 1).Offset(3, 3) = Ws.Range("J6") Sh.Range("a" & LR + 1).Offset(4, 3) = Ws.Range("J7") ' Sh.Range("a" & LR + 1).Offset(0, 4) = Ws.Range("D3") Sh.Range("a" & LR + 1).Offset(1, 4) = Ws.Range("D4") Sh.Range("a" & LR + 1).Offset(2, 4) = Ws.Range("D5") Sh.Range("a" & LR + 1).Offset(3, 4) = Ws.Range("D6") Sh.Range("a" & LR + 1).Offset(4, 4) = Ws.Range("D7") ' Sh.Range("a" & LR + 1).Offset(0, 5) = Ws.Range("l3") Sh.Range("a" & LR + 1).Offset(1, 5) = Ws.Range("l4") Sh.Range("a" & LR + 1).Offset(2, 5) = Ws.Range("l5") Sh.Range("a" & LR + 1).Offset(3, 5) = Ws.Range("l6") Sh.Range("a" & LR + 1).Offset(4, 5) = Ws.Range("l3") ' Sh.Range("a" & LR + 1).Offset(0, 6) = Ws.Range("e11") Sh.Range("a" & LR + 1).Offset(1, 6) = Ws.Range("e12") Sh.Range("a" & LR + 1).Offset(2, 6) = Ws.Range("e13") Sh.Range("a" & LR + 1).Offset(3, 6) = Ws.Range("e14") Sh.Range("a" & LR + 1).Offset(4, 6) = Ws.Range("e15") Sh.Range("a" & LR + 1).Offset(0, 7) = Ws.Range("l3") Sh.Range("a" & LR + 1).Offset(1, 7) = Ws.Range("l4") Sh.Range("a" & LR + 1).Offset(2, 7) = Ws.Range("l5") Sh.Range("a" & LR + 1).Offset(3, 7) = Ws.Range("l6") Sh.Range("a" & LR + 1).Offset(4, 7) = Ws.Range("l7") Sh.Range("a" & LR + 0).Offset(1, 7) = Ws.Range("f11") [a12] = [a12] + 1 Sh.Activate Sheets(1).Activate Reply = MsgBox(" تم الترحيل بنجاح" & Chr(10) & " هل تريد'طباعة الفاتورة ", vbYesNo) 'هنا هل تريد طبع النسخ ام لا If Reply <> 6 Then Exit Sub 'هنا هل تريد طبع النسخ ام لا ' ActiveWindow.SelectedSheets.PrintPreview 'معاينة قبل الطباعة ' ' Application.Dialogs(xlDialogPrinterSetup).Show '''هذا خاص باختيار الطباعه Application.ScreenUpdating = False With Sheets("صفحة العمل") 'هنا حدد الشيت المراد طباعتة' With .UsedRange For i = 1 To .Rows.Count If .Cells(i, 1).Value = "" Then .Cells(i, 1).EntireRow.Hidden = True '-c معتمد علي العمود 'هذا الستر الذي يمنع الفراغ End If Next i End With .PrintOut Rows.Hidden = False End With Application.ScreenUpdating = True end sub تفضل مثال 3.xlsm اخبرني بالنتيجه

وعليكم السلام احي Tarekchahine تفضل 1942.xlsm اخبرني بالنتيجة

اخي نثغةثمسخبف تفضل مثال 3.xlsm اخبرني بالنتيجه

اخي عربي مسلم اخي اعتقد ان الكود يعمل بكفائه بعد التعديل عليه تفضل ملف جديد.xlsm الكود بعد التعديل Private Sub Worksheet_Change(ByVal Target As Range) Application.Calculation = xlCalculationManual Dim ws As Worksheet Call Copie_sh Application.ScreenUpdating = False Application.DisplayAlerts = False Set ws = Sheets("ENTP-SH") If Target.Address = Range("B161").Address Then If Target.Value = "" Then ws.Unprotect Password:="1 1" Sheets("ENTP-SH").Rows(161).EntireRow.Hidden = True Else Sheets("ENTP-SH").Rows("161").EntireRow.Hidden = False End If End If If Target.Address = Range("B162").Address Then If Target.Value = "" Then Sheets("ENTP-SH").Rows(162).EntireRow.Hidden = True Else Sheets("ENTP-SH").Rows("162").EntireRow.Hidden = False End If End If If Target.Address = Range("B163").Address Then If Target.Value = "" Then Sheets("ENTP-SH").Rows(163).EntireRow.Hidden = True Else Sheets("ENTP-SH").Rows("163").EntireRow.Hidden = False End If End If If Target.Address = Range("B164").Address Then If Target.Value = "" Then Sheets("ENTP-SH").Rows(164).EntireRow.Hidden = True Else Sheets("ENTP-SH").Rows("164").EntireRow.Hidden = False End If ws.Protect Password:="1 1" End If If Not Intersect(Target, Range("E13:ai72:E101:AI164")) Is Nothing Then Range("E165:AI165").Formula = "=IF(COUNTIF(E$13:E$72:E$101:E$164,""P"")=0,"" "",COUNTIF(E$13:E$72:E$101:E$164,""P""))" Range("E165:AI165").Value = Range("E165:AI165").Value Range("E167:N167").Formula = "=IF(COUNTIF($E$165:$AH$165,E166)=0,"""",COUNTIF($E$165:$AH$165,E166))" Range("E166").Formula = "=IFERROR(LARGE($E$165:$AI$165,1),"""")" Range("F166:N166").Formula = "=IFERROR(LARGE($E$165:$AH$165,SUM($E$167:E167,1)),"""")" Range("E167:N167").Value = Range("E167:N167").Value Range("E166:N166").Value = Range("E166:N166").Value End If Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

اخي نثغةثمسخبف تفضل مثال 3.xlsm معاك خطوة خطوة .. اخبرني بالنتيجه

اخي Tarekchahine محرر الاكواد محمي اين Password: محرر الاكواد

اخي هاشم العلوي شرحك غير كافي وملفك غير موجود علي كل حال تفضل طلبك المصنف1.xlsm عند الضغط علي زر حفظ يتم حفظ الملف علي برتيشن d بالاسم المكتوب في خليه b1 اخبرني بالنتيجه جزاك الله خيرا

تفضل اخي عربي مسلم ضع كودك بين هذاين السترين 'Application.Calculation = xlCalculationManual 'Application.Calculation = xlCalculationAutomatic ان شاء الله يكون هو المطلوب الملف جاهز ملف جديد.xlsm

اخي نثغةثمسخبف : شرح غير واضح يورجي التوضيح المدي المراد ترحيلة هل هي خليه متفرقة ام تريد الترحيل من a3:x15 والي اي شيت تريد الترحيل جزاك الله خيراَ

اخي 2saad تفضل ملف (1).xlsm

اخي محمد عدنان هل تقصد هكذا نسخة من دفتر علامات 2022 المعدل (1).xlsm ان لم يكن !! يجب عليك التوضيح جزاك الله خيراً

اخي محمد عدنان تفضل من دفتر علامات 2022 المعدل.xlsm

تفضل طلبك DiskSerial.rar