سؤال بخصوص الوورد(طريقة الحفظ بارقام تسلسلية)

[احلى عالم]

سؤال بخصوص الوورد(طريقة الحفظ بارقام تسلسلية)

السلام عليكم

اخواني الكرام لدي سؤال اتمنى الاجابة عليه وهو:

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

مثلا دائما نكتب ( بسم الله الرحمن الرحيم) فيحفظ النص تلقائيا بهذا الاسم او تغيره حسب ما تريد.

سؤال هو:

اريد ان اجعل برنامج الوورد يحفظ الملفات بارقام تسلسلية.

مثلا: كتبت القطعة الاولى فانها تحفظ برقم واحد هكذا ( 1 )

والقطعة الثانية (2)

والثالثة(3)

...الخ

هل يمكنني ذلك.

اتمنى وارجوا اللاجابة

وشكرالكم.

احلى عالم

[المهاجر]

لا أعرف طريقة تلقائية ، ولكن ليس بالصعب اختيار اسم الملف وترقيمه كما تريد 1أو 2 أو 3...

[احلى عالم]

شكرا على ردك اخي الكريم

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

فلو كان هناك برمجة لارتحت كثيرا جدا.

تحياتي

[المهاجر]

للأسف ليس لدي فكرة عن البرمجة ، ولكن مجرد فكرة لمساعدة وهي عندما تقوم بحفظ الملفات في مجلد مستقل فإنك ستراها مرتبة حسب الأرقام ، وبالنظر إلى آخر ملف تعرف ما ذا ستسمي الملف الحالي..

تم تعديل مارس 13, 2004 بواسطه المهاجر

[احلى عالم]

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

[osama457]

عندي كود قديم جهزته للعمل

يبحث عن مجلد بمسار محدد ، وإذا ما هو موجود ينشئه

ثم ينظر للملفات الموجودة في المجلد، ويسمي الملف حسب آخر رقم .

سأحاول البحث عنه ثم أرفقه هنا .

[احلى عالم]

اذن انا بالانتظار اخي الكريم osama457

والف شكرا.

[osama457]

اخي

وحدت الملف بحمد الله

لكن يحتاج لتعديلات كثيرة

وقبل ما ابدا احب اسال

1- هل تريد يكون اسم الملف الزامي ، يعني اذا كان واصله الارقام الى 4 لا بد يكون الرقم 5 ، او احسن يكون فيه امكانة التغيير.

2- هل المجلد ثابت ما يتغير ، او يستحسن انه يكون فيه امكانية تغير حسب الرغبة.

واتمنى لو تطول بالك معي ، لاني ممكن اتاخر عليك شوي

[احلى عالم]

السلام عليكم

اهلا بك اخي osama457

وبارك الله فيك على حسن تعاملك وتعاونك وجعله الله في ميزان حسناتك.

واحب ان يكون الاختيار الثاني ( امكانية التغيير) لو تكرمت .

وخذ راحتك والوقت كله لك ولا تحرج نفسك ..... راحتك اولا ...

وتقبل تحياتي

احلى عالم

[osama457]

هذا هو الكود

Public Type OPENFILENAME
    lStructSize As Long '=========
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String '=========
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String '=========
    nMaxFile As Long '=========
    lpstrFileTitle As String '=========
    nMaxFileTitle As Long '=========
    lpstrInitialDir As String '=========
    lpstrTitle As String
    flags As Long '=========
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

' المسار الافتراضي ويعدل إلى المسار المطلوب
Public Const MyDefaultFolder  As String = "C:\My Documents"

Public Function ChooseFile() As String
On Error GoTo ChooseFile_mErr
'  هذا الكود لاختيار ملف
'  بواسطة مربع حوار اختيار ملف

 Dim ofn As OPENFILENAME
 Dim DirFile As String, mFileKind As String

 mFileKind = "doc"

 ofn.lStructSize = Len(ofn)
 ofn.lpstrFilter = mFileKind + " Files (*" + "." + mFileKind + ")" + Chr$(0) + "*" + "." + mFileKind + Chr$(0)
 ofn.lpstrFile = LastNum(MyDefaultFolder) & Space$(240)
 ofn.nMaxFile = 255
 ofn.lpstrFileTitle = Space$(254)
 ofn.nMaxFileTitle = 255
  ' السطر التالي لجعل المجلد الافتراضي هو المكتوب في الأعلى
 ofn.lpstrInitialDir = MyDefaultFolder
 ' لجعله يعرض المجلد حسب الطريقة المعتادة في الويندوز استبدله بالسطر التالي
 ' ofn.lpstrInitialDir = CurDir
 ofn.lpstrTitle = "اختيار اسم ومجلد للملف"
 ofn.flags = 0
        
 Dim A

 A = GetOpenFileName(ofn)
        
If (A) = False Then Exit Function
        
DirFile = Trim$(ofn.lpstrFile)
If Asc(Right(DirFile, 1)) = 0 Then DirFile = Left(DirFile, Len(DirFile) - 1)
If Right(DirFile, 4) <> "." & mFileKind Then DirFile = DirFile & "." & mFileKind

ChooseFile = DirFile

Exit Function
    
ChooseFile_mErr:
Select Case Err.Number
Case 32755:   MsgBox "لم تحدد اسم الملف", 64, " خطأ "
Case 20477:   MsgBox " اسم خاطئ للملف", 16, " خطأ "
End Select

End Function


Sub حفظ_تقليدي()
On Error GoTo حفظ_تقليدي_Err
Dim DirFile As String, FolderPath As String, Name_of_File As String
Dim I As Integer

DirFile = ChooseFile
If DirFile = "" Then Exit Sub

' إذا كان يوجد ملف بنفس الاسم يتم سؤال المستخدم عن رغبته في الكتابة عليه
If (Dir(DirFile)) <> "" Then
        If MsgBox("هناك خطاب يحمل نفس الاسم " & vbCrLf & vbCrLf _
             & "هل تود الكتابة عليه ؟؟" & vbCrLf & vbCrLf _
             & "انقر لا لإلغاء الحفظ ... انقر نعم للكتابة على الخطاب", _
            vbInformation + vbYesNo + vbDefaultButton2, _
            "تحذير") = vbNo Then
            '   يتم الخروج من بقية الكود في حال اختيار لا
            Exit Sub
        Else
                If MsgBox("هل أنت متأكد", _
                 vbInformation + vbYesNo, _
                "تأكيد") = vbNo Then
                Exit Sub
                End If
        End If
End If
  
Do
I = InStr(I + 1, DirFile, "\", 1)
If InStr(I + 1, DirFile, "\", 1) = 0 Then Exit Do
Loop

If I = 0 Then Exit Sub

FolderPath = Left(DirFile, I)
Name_of_File = Right(DirFile, Len(DirFile) - I)
MsgBox " DirFile = " & DirFile & vbCrLf _
        & "FolderPath = " & FolderPath & vbCrLf _
        & "Name_of_File = " & Name_of_File
'حفظ الخطاب
    ChangeFileOpenDirectory FolderPath
        ActiveDocument.SaveAs filename:=Name_of_File, FileFormat:=wdFormatDocument, _
         LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
         
Exit Sub

حفظ_تقليدي_Err:
MsgBox Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

Function LastNum(InPath As String) As String
On Error GoTo LastNum_Err
Dim mm As Integer, StrMM As String
mm = 0
Do
    mm = mm + 1
    StrMM = Format(mm, "000")
' يفترض في السطر التالي أن عدد الخطابات لن يزيد على 999 خطاب
' في حال كان أكثر من ذلك تعدل الأصفار إلى أربع أصفار
' وكذلك السطر الأخير
    StrGdNum = Format(MyGdNum, "000")
Loop While Dir(InPath & "\" & StrMM & ".doc") <> ""
LastNum = Format(mm, "000")
Exit Function

LastNum_Err:
End Function

ومرفق الكود

واحب انوه اني استفدت من امثلة في المنتدي الاكسس

وهذا الكود كود يحتاج تثبيته على قالب النورمال Normal

الخطوات :

الطريقة الأولى

فك ضغط الملف المرفق

افتح الوورد

أدوات - ماكرو - محرر Visual Basic

اضغط الزر اللي بجنب زر مثلث الهندسة واسمه Project Explorer

يطلع لك على اليسار قالب النورمال Normal

انقر عليه بالزر الايمن واختر Import File

يفتح لك نافذة اختيار الملف ، اختر الملف المرفق لك مع هذه المشاركة واسمه Module2.bas

الطريقة الثانية

فتح الوورد

أدوات - ماكرو - محرر Visual Basic

اضغط الزر اللي بجنب زر مثلث الهندسة واسمه Project Explorer

يطلع لك على اليسار قالب النورمال Normal

انقر عليه بالزر الايمن واختر Insert - Module

افتح الموديول الجديد وانسخ الكود فيه

سواء بالطريقة الاولى او الثانية يتحمل الكود عندك

واحسن تسويه له زر أو مفاتيح اختصار

طريقة عمل الزر

افتح الوورد

انقر على أي زر من الأزرار فوق بالزر الايمن

اختر تخصيص

اختر الاوامر

اختر وحدات ماكرو

اختر الماكرو : حفظ تقليدي

غير شكل الزر زي ما تبغى

طريقة مفاتيح الاختصار

افتح الوورد

انقر على أي زر من الأزرار فوق بالزر الايمن

اختر تخصيص

اضغط زر لوحة المفاتيح

اختر من الفئات وحدات الماكرو

واختر الماكرو : حفظ تقليدي

اجعل المؤشر في خانة اضغط مفتاح الاختصار الجديد

اضغط مفاتيح الاختصار اللي تبغاها تشغل الكود

ولا تنسى تختار : حفظ التغييرات في Normal.dot

ملاحظاتكم

Module2.zip

[احلى عالم]

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

اخي osama457

اشكر من كل قلبي على حسن تعاملك وعلى خدمتك الكبيرة لي ولبقية الاعضاء.

صراحة جهدك واضح جدا وكبير اشكرك مرة اخرى عليه.

وقد نفذت كل ما ذكرت واشتغل معاي تمام.

لكن عند الحفظ فانه يعطي اسم الملف الاول !!!

وهو بهذا الاسم:001

ويطلب مني ادخال اسما اخر او التعديل عليه للملف الثاني.

الذي كنت اريده هو :

عندما احفظ ملف باسم:001

واحفظ الملف الثاني فاني اريد ان يعطيني مباشرة:002

والثالث:003

وهكذا...

دون ان يعطيني اسما موجود مسبقا.

هذه ملاحظتي ولك تحياتي.

احلى عالم