(تمت الإجابة) إختيار إسم الحفظ ومكان الحفظ من قائمة

[ريان أحمد]

السلام عليكم

أرجومن سيادتكم مساعدتي في الملف الذي في المرفق

juin.rar

تم تعديل يناير 10, 2012 بواسطه tahar1983

[الـعيدروس]

السلام عليكم

جرب هذا الكود

Sub mSaveAs_ALI()

Application.EnableEvents = False

Application.DisplayAlerts = False

   ALI_JC = Range("F7")

    S_ALI = Sheet1.Range("D7")

	 P_ALI = ALI_JC & ":\"

	 If Sheet1.Range("D7").Value = "" Then

	 MsgBox "قم أولاً بتسجيل إسم الملف في الخلية المعنية", vbCritical, "_"

	  Exit Sub

	   Else:

	   If MsgBox(" هل تريد حفظ البيانات  في " & P_ALI & "  بإسم " & S_ALI, vbQuestion + vbYesNo) = vbYes Then

	   ActiveWorkbook.SaveCopyAs Filename:=P_ALI & S_ALI & ".xls"

    MsgBox "تم حفظ قاعدة بيانات بالأسم التالي..." & S_ALI & ALI_JC

  End If

  End If

Application.EnableEvents = True

Application.DisplayAlerts = True

End Sub

[ريان أحمد]

السلام عليكم

نعم هو المطلوب بدقة

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

[abouelhassan]

كل الاحترام والتقدير استاذنا الغالى لقلبى استاذ ورئيس قسم اخى ابا نصار

ممكن اضافة الى الكود

وهى قائمة منسدلة اخرى بها ارقام من 1 الى 31

وهى فولدرات

اى هذه القائمة تعمل فولدر بأسم رقم نختاره من هذه القائمة

كل احترامى

[ريان أحمد]

بعد إستعمال الكود الرجاء القيام بتعديل عليه وهو يتيح لك إختيار ملف جيد وتسميته كما تشاء

مثلا 2011 e tahar

e هو القرص وtahar هو إسم المجلد التذي ستحفظ فيه الملف و 2011 هو إسم الملف الذي ستحفضه

[الـعيدروس]

السلام عليكم

جرب هذا الكود

Sub ALIDROOS_JC_F()

Dim S_ALI$

Dim SAV_ALI As String

    SAV_ALI = Range("F7") & ":\" & Range("B7") & "\"

    S_ALI = Range("D7") & ".xls"

    If [B7].Value = "" Or [D7].Value = "" Or [F7].Value = "" Then

		 MsgBox "قم أولاً بتسجيل إسم الملف وقرص الحفظ في الخلية المعنية", vbCritical, "_"

		  Exit Sub

		   Else:

		   If MsgBox(" هل تريد حفظ البيانات  في " & SAV_ALI & "  بإسم " & S_ALI, vbQuestion + vbYesNo) = vbYes Then

    On Error Resume Next

    Application.DisplayAlerts = False

    GetAttr (SAV_ALI)

    Select Case Err.Number

    Case Is = 0

    Application.DisplayAlerts = False

    ThisWorkbook.SaveCopyAs SAV_ALI & S_ALI

    Application.DisplayAlerts = True

    Case Else

    MkDir SAV_ALI

    ThisWorkbook.SaveCopyAs SAV_ALI & S_ALI

    End Select

    On Error GoTo 0

	  MsgBox "تم حفظ قاعدة بيانات بالأسم التالي..." & S_ALI & ALI_JC

  End If

  End If

End Sub

وهذا المرفق

ALIDROOS_F.rar

تم تعديل يناير 10, 2012 بواسطه alidroos

[abouelhassan]

الله عليك تسلم ايديك وعينيك والله بحبك فى الله استاذنا

الله يحفظك ويبارك لنا فيك والله اخى الغالى واستاذى الحبيب ابا نصار روائع والماظ ولؤلؤ

احترام من كل قلبى

[الـعيدروس]

الحمد لله انه زبط معاك

جزاك الله خير ونسألك الدعاء ان الله ييسر الامور

تقبل تحياتي وشكري

[ريان أحمد]

السلام عليكم

-------------------------------------------------------------------------------------------------شكرا ---------------------------------------------------------------------------------------------------------

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

[abouelhassan]

الله ييسر امورك استاذنا ابا نصار ويبارك لك

اللهم امين

[احمدزمان]

ماشاء الله ابو نصار

عمل رائع وتمكن واضح

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

[الـعيدروس]

الاستاذ الحبيب احمد يعقوب حفظك الله

مرورك شرف لنا ونعتز به

ونشكر لك تشجيعك لنا المستمر

تقبل تحياتي وشكري

[احمدزمان]

اخي الكريم ابونصار

بعداذنك وبعد الكود الرائع الذي عملته

هذه فكرة اخرى بها عمل اسم الملف و المسار من داخل الإكسل

حيث ينتج لدينا كود صغير وبسيط

juin.rar

[الـعيدروس]

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

بتطوع المعادلات كيفما تريد

زادك الله من علمه وفضله

[احمدزمان]

شكرا لك اخي ابو نصار وجزاك الله كل خير

[أ / محمد صالح]

بارك الله لك أخي أبا نصار

استعمال للكود بطريقة تدل على فهم صائب

وبارك الله لك أخي أحمد

ربط بين المعادلات والكود رائع

وأرجو أن يتسع صدرك للتعديل البسيط على الكود (فهوايتي اختصار الأكواد)

Sub mSaveAs()

If Range("H7") = False Then

QQ = Range("J7")

MsgBox QQ

Exit Sub

End If

FN = Range("G7")

ActiveWorkbook.SaveAs Filename:=FN

End Sub

للملاحظة

تم الاستغناء عن سطري الذهاب إلى السطر رقم 9 والسطر نفسه واستبدالهما ب جملة الخروج من الإجراء

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

استاذ محمد صالح

شرف كبير لي مرورك الكريم وتعديلك الرائع

ولا انسى فضلك علي في كود البريد الإلكتروني

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

[ريان أحمد]

السلام عليكم

عند حفظ الملف وإختيار قرص لا يوجد أصلا في جهازي تم الحفظ حتى أنني إخترت حرف ب فقام بحفظ الملف لا أد

ري أين الرجاء التعديل لكي يعطي رسالة الخطأ عند إختيار قرص لا يوجد في الجهاز

[abouelhassan]

شكر وتقدير استاذنا احمد زمان

احترامى

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته.

الاساتذه الافاضل جميعاً جزاكم الله كل خير

أبو أنس

[abouelhassan]

الاساتذة هل يمكن تعديل الكود ليصبح

البارتشن ثم فولدر بداخله فولدر الشهر بداخله فولدر اليوم فالملف

احترامى

[الـعيدروس]

السلام عليكم

اخي ابو الحسن

للعتديل يكون كالتالي

البارتشن :C

الملف الاول مثلا اسمه A

الملف الثاني اسمه B

الاسم الثالث اسمه C

ثم ملف الاكسل اسمه Ahssan

بيكون كالاتي

C:\A\B\C\Ahssan.xls

[abouelhassan]

اخى ابا نصار بارك الله فيك

ممكن حضرتك ترفق لى ملف

احترامى لحضرتك استاذنا

[الـعيدروس]

السلام عليكم

ألاخ ابو الحسن

ولايهمك انت أامر

جرب المرفق

ALIDROOS_F1.rar

[abouelhassan]

اشكرك استاذنا

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

قمت بالتنفيذ استاذنا ولم يتم

كل يوم احفظ ملف اسمه الارتباطات بداخل فولدر اسمه الارتباطات باك اب بداخله فولدر اسمه 2012 بداخله مجموعة فولدارات باسم الاشهر

يعنى يناير وفبراير الخ وبداخل كل واحد مجموعة فولدرات 1 و 2 و3 حتى 31 وهى ايام الشهر

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

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

بمعن لو فولدر الارتباطات باك اب بداخله فولدرات يناير فبراير مارس الخ بداخله فولدر الايام 1 2 3 الخ ثم اسم الملف الارتباطات

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

احترامى