مشكل با Application.GetOpenFilename

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

    • 2017/01/20
    • 244

    [حل شده] مشكل با Application.GetOpenFilename

    سلام و عرض ادب
    با استفاده از این كد، میخوام یك فایل اكسل رو باز كنم
    Dim strfile As String
    strfile = Application.GetOpenFilename("Excel Workbooks,*.xls", , "لطفا فايل حاوي كدهاي رهگيري را انتخاب نماييد")

    Workbooks.Open (strfile)

    مشكل اینجاست كه اگر موقع انتخاب فایل، گزینه انصراف رو بزنم و فایلی رو باز نكنم، نرم ‌افزار خطا میده و خارج میشه، نمیدونم باید چه كدی بنویسم كه در این صورت خطا نده
    ممنون میشم اساتید محترم راهنمایی بفرمایید
  • generalsamad
    مدير تالار توابع

    • 2014/06/22
    • 1496

    #2
    با سلام
    این کد را به خط اول اضافه کنید
    کد PHP:
    On Error Resume Next 
    [CENTER]
    [SIGPIC][/SIGPIC]
    [/CENTER]

    کامنت

    • ظهور 313

      • 2017/01/20
      • 244

      #3
      ممنون از شما استاد محترم
      اگر اشتباه نكنم این دستور، به كدهای بعدی میره و اونها رو اجرا میكنه، در صورتی كه من میخوام در صورتی كه عملیات بازكردن فایل كنسل شد، بقیه دستورات هم لغو بشه و انجام نشه
      لطفا راهنمایی بفرمایید

      کامنت

      • generalsamad
        مدير تالار توابع

        • 2014/06/22
        • 1496

        #4
        با سلام
        اینو امتحان کنید
        در صورتی که بخواهید عملیات انجام شود قبل از msgbox که شرط برقرار هست دستوراتتون رو وارد کنید
        کد PHP:
        Sub test()
        Dim i As Integer
        Dim Style
        Response
        Style 
        vbYesNo vbCritical vbDefaultButton2
        Response 
        MsgBox("عمليات انجام شود؟"Style"هشدار")
        If 
        Response vbYes Then
            MsgBox 
        "عمليات انجام شد"
        Else
            
        MsgBox "صرف نظر شد"
        End If
        End Sub 
        [CENTER]
        [SIGPIC][/SIGPIC]
        [/CENTER]

        کامنت

        • generalsamad
          مدير تالار توابع

          • 2014/06/22
          • 1496

          #5
          شاید هم اینطور منظورتون باشه

          کد PHP:
          Sub test2()
          Application.ScreenUpdating False
          Application
          .EnableEvents False
          Application
          .Calculation xlManual

          On Error Resume Next
          Dim customerBook 
          As Workbook
          Dim strfile 
          As String
          Dim customerWorkbook 
          As Workbook
          Dim targetWorkbook 
          As Workbook
          Set targetWorkbook 
          Application.ActiveWorkbook

          strfile 
          Application.GetOpenFilename("Excel Workbooks (*.xlsx;*.xls;*.xla),*.xlsx;*.xls;*.xla", , "لطفا فايل حاوي كدهاي رهگيري را انتخاب نماييد")
          Set customerWorkbook Application.Workbooks.Open(strfile)
          If 
          customerWorkbook.Name "" Then Exit Sub
          MsgBox 
          "ok"
          End Sub 
          [CENTER]
          [SIGPIC][/SIGPIC]
          [/CENTER]

          کامنت

          • ظهور 313

            • 2017/01/20
            • 244

            #6
            ممنون بابت پاسخگوییتون
            اما اینم مشكل رو حل نمیكنه
            با این فرمول شما، فقط میشه قبل از باز شدن صفحه بازشدن فایل، انصراف داد اما وقتی صفحه مربوط به دستور Application.GetOpenFilename باز شد، اگر باز انصراف بزنی، خطا ایجاد میشه

            کامنت

            • generalsamad
              مدير تالار توابع

              • 2014/06/22
              • 1496

              #7
              نوشته اصلی توسط generalsamad
              شاید هم اینطور منظورتون باشه

              کد PHP:
              Sub test2()
              Application.ScreenUpdating False
              Application
              .EnableEvents False
              Application
              .Calculation xlManual

              On Error Resume Next
              Dim customerBook 
              As Workbook
              Dim strfile 
              As String
              Dim customerWorkbook 
              As Workbook
              Dim targetWorkbook 
              As Workbook
              Set targetWorkbook 
              Application.ActiveWorkbook

              strfile 
              Application.GetOpenFilename("Excel Workbooks (*.xlsx;*.xls;*.xla),*.xlsx;*.xls;*.xla", , "لطفا فايل حاوي كدهاي رهگيري را انتخاب نماييد")
              Set customerWorkbook Application.Workbooks.Open(strfile)
              If 
              customerWorkbook.Name "" Then Exit Sub
              MsgBox 
              "ok"
              End Sub 
              این کد رو امتحان کردید؟
              [CENTER]
              [SIGPIC][/SIGPIC]
              [/CENTER]

              کامنت

              • ظهور 313

                • 2017/01/20
                • 244

                #8
                نوشته اصلی توسط generalsamad
                شاید هم اینطور منظورتون باشه

                کد PHP:
                Sub test2()
                Application.ScreenUpdating False
                Application
                .EnableEvents False
                Application
                .Calculation xlManual

                On Error Resume Next
                Dim customerBook 
                As Workbook
                Dim strfile 
                As String
                Dim customerWorkbook 
                As Workbook
                Dim targetWorkbook 
                As Workbook
                Set targetWorkbook 
                Application.ActiveWorkbook

                strfile 
                Application.GetOpenFilename("Excel Workbooks (*.xlsx;*.xls;*.xla),*.xlsx;*.xls;*.xla", , "لطفا فايل حاوي كدهاي رهگيري را انتخاب نماييد")
                Set customerWorkbook Application.Workbooks.Open(strfile)
                If 
                customerWorkbook.Name "" Then Exit Sub
                MsgBox 
                "ok"
                End Sub 

                ممنونم استاد
                بسیار عالی
                مشكلم حل شد

                کامنت

                چند لحظه..