ایجاد فایل توسط ماکرو

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • alirezaariana

    • 2014/06/02
    • 8

    ایجاد فایل توسط ماکرو

    سلام من میخوام ماکرویی بنویسم که با اجرای آن فایلی در مسیر مشخصی ایجاد بشه و نام آن فایل رو از توی یک سلول بخونه و نام گذاری کنه .
    لطفا کمکم کنید.
    مثال : Sheet1 سلول A1 = حسین
    فایل جدیدی در Desktop با نام حسین.txt ایجاد کنه.
  • امين اسماعيلي
    مدير تالار ويژوال بيسيك

    • 2013/01/17
    • 1198

    #2
    با درود
    قربون شکل ماهت علیرضا خان اخه تو تالار اموزش میای پرسش و پاسخ رو مطرح میکنی - منم گولتو خوردم گفتم اخ جون یه مطلب اموزشی جدید - لطفا به اینکه سوال رو کجا مطرح میکنین بیشتر دقت کنین
    در پناه خداوندگار ایران زمین باشید و پیروز

    کامنت

    • ابوالفضل براتی
      • 2016/08/27
      • 3

      #3
      کد زیر را وارد کن
      "ActiveWindow.Saveas FileName:=ThisWorkBook.Path & "" & ThisWorkBook.Sheets("Sheet1").Range("A1").Value &".xls

      کامنت

      • ابوالفضل براتی
        • 2016/08/27
        • 3

        #4
        کد زیر را وارد کن
        'این کد شیت 1 فایل باز رو میبره تو فولدری که تو سلولA1 اسمش رو نوشتی با نام فایل که تو سلول A2 نوشتی ذخیره می کنه ، دفعه بعد هم اگه نخوای فولدر تغییر کنه میبره تو همون فولدر قبلی ذخیره میکنه
        Sub MakeMyFolder()


        Dim fdObj As Object
        Dim MyDrive, MyFolder, MyFileName, FolderCreat, MyPath, Directory As String

        'اینجا داخل "" اسم درایوی که میخوای فایل جدید سیو بشه رو بنویس
        MyDrive = "E:"

        'اینجا توی"" اگه بعد از درایو فولدر خاصی مد نظرت هست وارد کن
        MyFolder = "Abalfazl-Fils\PS\Training\Files"
        FolderCreat = ThisWorkbook.Sheets(1).Range("A1").Value & ""

        MyFileName = ThisWorkbook.Sheets(1).Range("A2").Value

        Directory = MyDrive & MyFolder & FolderCreat
        MyPath = Directory & MyFileName
        Application.ScreenUpdating = False

        Set fdObj = CreateObject("Scripting.FileSystemObject")

        If fdObj.FolderExists(Directory) Then

        MsgBox "Found it.", vbInformation, "itsavad.ir"
        Dim wb As Workbook


        Set wb = Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Sheets(2).Copy Before:=wb.Sheets(1)




        With wb

        .SaveAs MyPath, FileFormat:=xlOpenXMLWorkbook
        .Close savechanges:=False
        End With
        Else
        fdObj.CreateFolder (Directory)

        MsgBox "It has been created.", vbInformation, "itsavad.ir"


        Set wb = Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Sheets(2).Copy Before:=wb.Sheets(1)




        With wb

        .SaveAs MyPath, FileFormat:=xlOpenXMLWorkbook
        .Close savechanges:=False



        MsgBox "File Saved", vbInformation


        End With
        End If
        Application.ScreenUpdating = True


        End Sub


        'اینجا داخل "" اسم درایوی که میخوای فایل جدید سیو بشه رو بنویس

        کامنت

        • mrhartsclube

          • 2017/11/15
          • 130

          #5
          نوشته اصلی توسط alirezaariana
          سلام من میخوام ماکرویی بنویسم که با اجرای آن فایلی در مسیر مشخصی ایجاد بشه و نام آن فایل رو از توی یک سلول بخونه و نام گذاری کنه .
          لطفا کمکم کنید.
          مثال : Sheet1 سلول A1 = حسین
          فایل جدیدی در Desktop با نام حسین.txt ایجاد کنه.
          سلام دوست عزیز
          برای این کار کد زیر رو استفاده کنید یه فایل در Desktop با نام محتویات سلول A1 ایجاد میکنه و داخلش مینویسه Salam! البته متنشو میتونید عوض کنید یا اصلا حذفش کنید که فایل متنی خالی ساخته شه:

          کد PHP:
          Set fs CreateObject("Scripting.FileSystemObject")
              
          Set a fs.CreateTextFile(Environ("USERPROFILE") & "\Desktop\" & Worksheets("Sheet1").Cells(1,1).Value & ".txt", True)
              a.WriteLine("
          Salam")
              a.Close 
          ... Programming C# - VB.Net - VC++ - ASP.Net - HTML - CSS - JS - AS2 - AutoIt - Pascal - Delphi - PHP - Python - VBA - Etc
          ... 2D & 3D Graphic Designer| 2D & 3D Animator | Game Designer & Hacker | Data Forensic Expert | Ethical Hacker | Pen Tester

          .: Expert in doing what nobody else can :.

          کامنت

          Working...