لا اريد تغير اسم الملف الرئيسي -

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

اساتذة وخبراء هذا المنتدي الجميل جزاكم الله خيراً

اريد بعد الضغط علي الزر وحفظ الملف النصي - يبقي البرنامج الرئيسي كما هو -لا اريد تغير اسم الملف الرئيسي

 

الملف الملف الرئيسي.xlsm

[lionheart]

Sub Test()
    Dim sName As String
    sName = Cells.Text & "D:\" & Cells(1, 2).Text & " Copy" & Format(Now, "-dddd-dd-mm-yyyy-")
    SaveWorkbookAs ThisWorkbook, sName, xlTextWindows
End Sub

Public Function SaveWorkbookAs(pWorkbook As Workbook, pFileName As String, pFileFormat As XlFileFormat) As Boolean
    Dim wFSO As Scripting.FileSystemObject, wWorkbook As Workbook, wScreenUpdating As Boolean, wEnableEvents As Boolean, wDisplayAlerts As Boolean, wTempName As String
    On Error Resume Next
    SaveWorkbookAs = False
    Set wFSO = New Scripting.FileSystemObject
    If pWorkbook Is Nothing Then GoTo EndFunction
    If (pFileName = vbNullString) Then GoTo EndFunction
    If (pWorkbook.FileFormat = pFileFormat) Then
        Err.Clear
        pWorkbook.SaveCopyAs pFileName
        SaveWorkbookAs = (Err.Number = 0)
        GoTo EndFunction
    End If
    With Application
        wScreenUpdating = .ScreenUpdating:  .ScreenUpdating = False
        wEnableEvents = .EnableEvents:      .EnableEvents = False
        wDisplayAlerts = .DisplayAlerts:    .DisplayAlerts = False
    End With
    Err.Clear
    wTempName = wFSO.GetTempName
    pWorkbook.SaveCopyAs wTempName
    If (Err.Number > 0) Then GoTo EndFunction
    Err.Clear
    Set wWorkbook = Application.Workbooks.Open(wTempName, xlUpdateLinksNever)
    If (Err.Number > 0) Then GoTo EndFunction
    wWorkbook.SaveAs Filename:=pFileName, FileFormat:=pFileFormat
    SaveWorkbookAs = (Err.Number = 0)
    wWorkbook.Close SaveChanges:=False
EndFunction:
    If (VBA.LenB(wTempName) > 0) Then If wFSO.FileExists(wTempName) Then wFSO.DeleteFile wTempName, True
    With Application
        .ScreenUpdating = wScreenUpdating
        .EnableEvents = wEnableEvents
        .DisplayAlerts = wDisplayAlerts
    End With
    Set wWorkbook = Nothing: Set wFSO = Nothing
End Function

 

From Tools > References: Microsoft Scriting Runtime

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

اخي   lionheart  شكراً علي الرد

 

لم افهم  هذا الكود وما علاقتة بالمطلوب

المطلوب ان لا يتغير اسم الملف الرئيسي اسناء تنفيز الكود  المرفق بالمشاركة الالولي

انا عند ما اريد حفظ الشيت في ملف منفصل بأسم الخليه b1 بيتم تغير اسم الملف الرئيسي ايضاً وانا مش عايز  اسم الملف الرئيسي يتغير

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

[lionheart]

Run the macro called "Test". The macro will save a text file copy of the file as you wish exactly and in the same path as in your code.
Please try the code first before you post a reply.

 

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

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

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

[lionheart]

i didn't get what you mean exactly

The code I posted is doing the same task as your code but keep the original workbook open. Please copy the code and insert it to a new module then go back to the worksheet then press Alt + F8 and run the code called "Test" and finally go to the partition d to see the text file output

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

اخي  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]

I will not waste more time with this issue. Wait for others for help

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

اخي  lionheart

لا ادري مذا تقصد بهذه الاكواد وهي لم  تفي بالمطلوب

 

[حسونة حسين]

اخى الكريم  @محمد يوسف ابو يوسف

16 ساعات مضت, محمد يوسف ابو يوسف said:

لاادري مذا تقصد بهذه الاكواد

تمام انت صح في هذه النقطه

16 ساعات مضت, محمد يوسف ابو يوسف said:

وهي لم  تفي بالمطلوب

انت مخطئ في هذه النقطه

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

جزاه الله خيرا الاستاذ @lionheart على هذا الكود 

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

اخي  hassona229  

ممكن ترسل لية الملف الذي جربته ويفي  بالمطلوب

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

[حسونة حسين]

تفضل ابو يوسف 

 

Save As Text.xlsm

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

اخي hassona229 جزاك الله خيرا--- فعلاً هذا هو المطلوب

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

[حسونة حسين]

اخى الكريم  @محمد يوسف ابو يوسف

كيف تجعل اجابتى افضل اجابه وما هى الا ان وضعت لك الكود الخاص بالاستاذ @lionheart فاجابته هى التى تكون افضل اجابه وليس اجابتى 

اعطى كل زى حق حقه اخى الكريم 

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

بسم الله الرحمن الرحيم  والحمد الله رب العالمين

بعد البحث الكثير  داخل المنتدي وخارج المنتدي لم اجد ما اريد

ولكن صممت ان اوجد ما اريد 

والحمد لله  وفقني الله -- ان اكتب هذا الكود الجميل الذي يفي بألمطلوب 

وكررت ان اضعه للفائدة

كود تصدير مدي محدد الي ملف نصي وحفظه بأسم خليه معينة - علي برتيشن d

Sub dحفظ_ملف_تاست_بأسم_خلية_علي_برتيشن()
                  Range("A1:I108").Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="D:\" & Cells(1, 2).Text & Nombre & " نسخة" & Format(Now, "-dddd-dd-mm-yyyy-") & ".txt", FileFormat:=xlText, _
        CreateBackup:=False
    ActiveWindow.Close
    Range("A1").Select
End Sub

تصدير البيانات الي ملف نصي وحفظة بأسم خلية معينه تصدير البيانات الي ملف نصي وحفظ بأسم خلية معينه.xls