اجرای فایل ها از طریق فرم vba

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • سید مسعود قمی

    • 2019/07/02
    • 57

    [حل شده] اجرای فایل ها از طریق فرم vba

    سلام دوستان لطفا راهنمایی کنید.

    فرمی درست کردم که شامل یک عدد تکسباکس و باتن می باشد. و داخل پوشه ای کلی فایل اعم از عکس، پی دی اف، ورد و ... دارم.
    میخوام وقتی که نام فایلی از فایل های پوشه مورد نظر را در تکسباکس وارد کردم با زدن دکمه باتن فایل مورد نظر اجرا بشه.
  • M_ExceL

    • 2018/04/23
    • 677

    #2
    نوشته اصلی توسط سید مسعود قمی
    سلام دوستان لطفا راهنمایی کنید.

    فرمی درست کردم که شامل یک عدد تکسباکس و باتن می باشد. و داخل پوشه ای کلی فایل اعم از عکس، پی دی اف، ورد و ... دارم.
    میخوام وقتی که نام فایلی از فایل های پوشه مورد نظر را در تکسباکس وارد کردم با زدن دکمه باتن فایل مورد نظر اجرا بشه.
    سلام،
    از کد زیر استفاده کنید :
    کد:
    Private Sub CommandButton1_Click()
    Dim pt, fnameF, NFF As String
    fname = Me.TextBox1.Text
    pt = "C:\Users\test\Desktop\New folder (23)\"
    fnameF = Dir(pt & fname & "*.*")
    NFF = pt & fnameF
    CreateObject("shell.application").Open (NFF)
    End Sub
    توجه : ابتدا مسیر رو داخل کد اصلاح کنید و مسیر فایل های خودتون رو قرار بدید.
    یا حق.
    [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
    [/CENTER]

    کامنت

    • سید مسعود قمی

      • 2019/07/02
      • 57

      #3
      سلام استاد محترم بسیار ممنون از جوابتون خیلی کاربردی بود
      برای کامل تر شدن عرض میکنم
      میخوام وقتی که فایل رو پیدا نکرد
      این پیغام رو بده
      "کاربر محترم فایل مورد نظر یافت نشد"

      کامنت

      • سید مسعود قمی

        • 2019/07/02
        • 57

        #4
        سلام استاد
        من کد بالا رو استفاده کردم خیلی خوب جواب داد منتهی وقتی میخوام همین کد رو توی همون یوزرفرم برای باتن دیگه هم استفاده کنم جواب نمیده. چرا؟
        ممنون میشم راهنمایی کنید.

        کامنت

        • misammisam
          مدير تالار حسابداری و اکسل

          • 2014/04/04
          • 892
          • 64.00

          #5
          نوشته اصلی توسط سید مسعود قمی
          سلام استاد
          من کد بالا رو استفاده کردم خیلی خوب جواب داد منتهی وقتی میخوام همین کد رو توی همون یوزرفرم برای باتن دیگه هم استفاده کنم جواب نمیده. چرا؟
          ممنون میشم راهنمایی کنید.
          شما احتمالا کل کد ها رو کپی میکنید ، برای دکمه دیگه فقط باید قسمت داخل رو درون کد دکمه جدید قزار بدید ، یعنی اینهارو :
          کد PHP:
          Dim ptfnameFNFF As String
          fname 
          Me.TextBox1.Text
          pt 
          "C:\Users\test\Desktop\New folder (23)\"
          fnameF = Dir(pt & fname & "
          *.*")
          NFF = pt & fnameF
          CreateObject("
          shell.application").Open (NFF) 
          [CENTER][SIGPIC][/SIGPIC]
          [/CENTER]
          [CENTER][FONT=Tahoma][FONT=Tahoma][FONT=Tahoma][FONT=Tahoma][FONT=Tahoma][INDENT]
          [CENTER][SIZE=3][URL="https://affstat.adro.co/click/adf04053-f8a6-439a-9ac4-e6a7e6f4b455"][B]اينجا كليك نكنيا ![/B][/URL][/SIZE]
          [/CENTER]
          [/INDENT]

          [/FONT][/FONT][/FONT][/FONT][/FONT]
          [/CENTER]

          کامنت

          • M_ExceL

            • 2018/04/23
            • 677

            #6
            نوشته اصلی توسط سید مسعود قمی
            سلام استاد محترم بسیار ممنون از جوابتون خیلی کاربردی بود
            برای کامل تر شدن عرض میکنم
            میخوام وقتی که فایل رو پیدا نکرد
            این پیغام رو بده
            "کاربر محترم فایل مورد نظر یافت نشد"
            سلام، خواهش میکنم
            کد زیر رو تست کنید :
            کد:
            Private Sub CommandButton1_Click()
            Dim fname, pt, fnameF, NFF, br As String
            Dim i, b As Byte
                pt = "C:\Users\test\Desktop\New folder (23)\"
                If Me.TextBox1.Text = Empty Then
                    MsgBox Chr(225) & Chr(216) & Chr(221) & Chr(199) & Chr(32) _
                    & Chr(228) & Chr(199) & Chr(227) & Chr(32) & Chr(221) & Chr(199) _
                    & Chr(237) & Chr(225) & Chr(32) & Chr(209) & Chr(199) & Chr(32) & Chr(230) _
                    & Chr(199) & Chr(209) & Chr(207) & Chr(32) & Chr(152) & Chr(228) & Chr(237) _
                    & Chr(207)
                    Exit Sub
                End If
                fname = Me.TextBox1.Text
                fnameF = Dir(pt & fname & "*.*")
                    If fnameF <> Empty Then
                        i = 1: b = 1
                            Do While br <> "."
                                br = Mid(fnameF, i, 1)
                                i = i + 1
                                b = b + 1
                            Loop
                    Else
                        MsgBox Chr(152) & Chr(199) & Chr(209) & Chr(200) & Chr(209) & Chr _
                        (32) & Chr(227) & Chr(205) & Chr(202) & Chr(209) & Chr(227) & Chr(32) & Chr(221) _
                        & Chr(199) & Chr(237) & Chr(225) & Chr(32) & Chr(227) & Chr(230) & Chr(209) & Chr(207) _
                        & Chr(32) & Chr(228) & Chr(217) & Chr(209) & Chr(32) & Chr(237) & Chr(199) & Chr(221) & _
                        Chr(202) & Chr(32) & Chr(228) & Chr(212) & Chr(207)
                        Exit Sub
                    End If
                If Me.TextBox1.Text <> Left(fnameF, b - 2) Then
                    MsgBox Chr(152) & Chr(199) & Chr(209) & Chr(200) & Chr(209) & Chr _
                    (32) & Chr(227) & Chr(205) & Chr(202) & Chr(209) & Chr(227) & Chr(32) & Chr(221) _
                    & Chr(199) & Chr(237) & Chr(225) & Chr(32) & Chr(227) & Chr(230) & Chr(209) & Chr(207) _
                    & Chr(32) & Chr(228) & Chr(217) & Chr(209) & Chr(32) & Chr(237) & Chr(199) & Chr(221) & _
                    Chr(202) & Chr(32) & Chr(228) & Chr(212) & Chr(207)
                    Exit Sub
                Else
                    fnameF = Dir(pt & fname & "*.*")
                    NFF = pt & fnameF
                    CreateObject("shell.application").Open (NFF)
                End If
            End Sub
            یا حق.
            فایل های پیوست شده
            [CENTER]Telegram Channel : [url]https://t.me/UltraOfficeSkills[/url]
            [/CENTER]

            کامنت

            • سید مسعود قمی

              • 2019/07/02
              • 57

              #7
              استاد خیلی خیلی ممنون مشکلم حل شد.

              کامنت

              چند لحظه..