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

الردود الموصى بها

قام بنشر

تحياتي لجميع المشرفين والعلماء والخبراء في هذا الصرح المتميز

المطلوب من هذا الملف هو عند الضغط على زر (حفظ الملف ) يتم تفحص المسارات

C:\data , D:\data , E:\data

وتفقد المجلد data بالأخص على المسارات المذكورة

فإذا لم تكن المجلدات ذات الاسم data موجودة على المسارات المحددة أو أحدها يتم إنشاؤه على المسار تلقائيا وحفظ ملف الاكسل عليها جميعا

ولكم جزيل الشكر والتقدير

إنشاء مجلد على مسار محدد وحفظ ملف الاكسل عليه.rar

قام بنشر

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

وجدت طريقة أخرى على المنتدى على الرابط http://www.officena....=1

وقمت بتعديل الكود إلى التعديل التالي ليتناسب مع مطلبي ولا أعلم إن كان هذا الكود طويل أم لا ولكنه قام بالواجب وتم تنفيذ المطلوب بشكل ممتاز

وإذا كان هناك تعديل على الكود أرجو إفادتي ولكم جزيل الشكر

Sub copy1()

Dim Extension$

Dim savePathName As String

Extension = ThisWorkbook.Name

savePathName = "c:\data\"

	On Error Resume Next

	Application.DisplayAlerts = False

	GetAttr (savePathName)

	Select Case Err.Number

	Case Is = 0

			Application.DisplayAlerts = False

			ThisWorkbook.SaveCopyAs savePathName & Extension

			Application.DisplayAlerts = True

	Case Else

			MkDir savePathName

			ThisWorkbook.SaveCopyAs savePathName & Extension

	End Select

	On Error GoTo 0


	Extension = ThisWorkbook.Name

savePathName = "d:\data\"

	  On Error Resume Next

	Application.DisplayAlerts = False

	GetAttr (savePathName)

	Select Case Err.Number

	Case Is = 0

			Application.DisplayAlerts = False

			ThisWorkbook.SaveCopyAs savePathName & Extension

			Application.DisplayAlerts = True

	Case Else

			MkDir savePathName

			ThisWorkbook.SaveCopyAs savePathName & Extension

	End Select

	On Error GoTo 0


End Sub

شكرا أخي ابو احمد على تعاونك

شكرا للجميع

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information