Subscript out of range (Error 9)

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

    • 2019/11/08
    • 142
    • 38.00

    پرسش Subscript out of range (Error 9)

    با سلام خدمت دوستان محترم و اعضای عزیز

    در فایل اکسل کد نوشتم بدلیل سنگین بودن فایل با عرض پوزش کد هارو میزارم خدمتتون
    کد:
    Sub Print_Form()
    
        Dim x As Integer
        x = 2
        Do
        Call Fill_Form(x)
        Sheets("فرم نصب").PrintOut
        x = x + 1
        Loop Until IsEmpty(Sheets("تخصيصي روز").Cells(x, 1))
    
    
    
    
    End Sub
    
    
    
    
    
    
    Sub Fill_Form(x As Integer)
    
    
    Sheets("فرم نصب").Shapes("TextBox 49").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 3)
    Sheets("فرم نصب").Shapes("TextBox 22").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 18)
    Sheets("فرم نصب").Shapes("TextBox 24").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 31)
    Sheets("فرم نصب").Shapes("TextBox 84").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 16)
    Sheets("فرم نصب").Shapes("TextBox 37").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 17)
    Sheets("فرم نصب").Shapes("TextBox 10").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 29)
    Sheets("فرم نصب").Shapes("TextBox 8").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 25)
    Sheets("فرم نصب").Shapes("TextBox 7").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 26)
    Sheets("فرم نصب").Shapes("TextBox 26").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 23)
    Sheets("فرم نصب").Shapes("TextBox 4").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 5)
    Sheets("فرم نصب").Shapes("TextBox 59").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 1)
    Sheets("فرم نصب").Shapes("TextBox 54").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 8)
    Sheets("فرم نصب").Shapes("TextBox 47").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 7)
    Sheets("فرم نصب").Shapes("TextBox 55").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 6)
    Sheets("فرم نصب").Shapes("TextBox 2").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 28)
    Sheets("فرم نصب").Shapes("TextBox 9").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 10)
    Sheets("فرم نصب").Shapes("TextBox 23").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 19)
    Sheets("فرم نصب").Shapes("TextBox 64").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 17)
    Sheets("فرم نصب").Shapes("TextBox 3").DrawingObject.Text = Sheets("آدرس").Cells(x, 2)
    Sheets("فرم نصب").Shapes("TextBox 6").DrawingObject.Text = Sheets("آدرس").Cells(x, 3)
    Sheets("فرم نصب").Shapes("TextBox 13").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 26)
    Sheets("فرم نصب").Shapes("TextBox 1").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 16)
    Sheets("فرم نصب").Shapes("TextBox 11").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 17)
    Sheets("فرم نصب").Shapes("TextBox 14").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 3)
    Sheets("فرم نصب").Shapes("TextBox 15").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 26)
    Sheets("فرم نصب").Shapes("TextBox 16").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 28)
    Sheets("فرم نصب").Shapes("TextBox 17").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 6)
    Sheets("فرم نصب").Shapes("TextBox 34").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 19)
    Sheets("فرم نصب").Shapes("TextBox 19").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 11)
    Sheets("فرم نصب").Shapes("TextBox 18").DrawingObject.Text = Sheets("تخصيصي روز").Cells(x, 10)
    Sheets("فرم نصب").Shapes("TextBox 20").DrawingObject.Text = Sheets("آدرس").Cells(x, 7)
    
    
    End Sub
    مشاهده میفرمایید در شیت "فرم نصب" قرار داد وجود دارد و در شیت "تخصیصی روز" اطلاعات قرار داد در ردیف ها
    هر بار از هر ردیف اطلاعات در فرم بارگذاری و چاپ می شود
    و سپس ردیف بعدی و چاپ

    هنگامی که از در شیت "تخصیصی روز" ردیف ها
    Delete sheete rowe
    می شود
    و اطلاعات جدید
    وارد می شود خطای زیر داده می شود

    ***اگر محدوده اطلاعات انتخاب شود پاک شود و اطلاعات جدید کپی شود خطا نمی دهد ****


    Click image for larger version

Name:	2021-05-17_22-36-12.jpg
Views:	1
Size:	15.8 کیلو بایت
ID:	149298

    Click image for larger version

Name:	2021-05-17_22-37-05.jpg
Views:	1
Size:	350.5 کیلو بایت
ID:	149299

    Click image for larger version

Name:	2021-05-17_22-37-28.jpg
Views:	1
Size:	186.2 کیلو بایت
ID:	149300



    Subscript out of range.zip
    Last edited by armey; 2021/05/18, 00:16.
  • armey

    • 2019/11/08
    • 142
    • 38.00

    #2
    دوستان عزیز و اعضای محترم



    خواهشمندم اگر دوستی علت این خطا را میداند کمک کند

    فایل رو مختصر کردم
    نگاه کنید


    اگر به فایل یک شیت خالی اضافه کنید و ذخیره کنید یک خطا میده که نمیدونم چرا و چیه؟
    ((ولی فایل کار میکنه))

    حالا
    اگه اسم شیت(((sheet3))) رو عوض منید مثلا بزارید (((فرم نصب)))
    و به محیط ماکرو بروید و اسم هارو تغییر بدید

    خطایی رو که تو موضوع پست سوال کردم می بینید .




    با سپاس و تجدید احترام

    کامنت

    • حسام بحرانی

      • 2013/09/29
      • 2065
      • 72.00

      #3
      Remove personal information from file properties on save

      سلام دوست عزیز
      برای رفع خطایی که عنوان کردید ( با اضافه شدن شیت خطا میده ) مسیر زیر رو بروید :
      کد HTML:
      Options > Trust Center > Trust Center Settings > Privacy Options
      سپس تیک زیر رو بردارید:
      کد HTML:
      Remove personal information from file properties on save
      موفق باشید.
      [CENTER][B][SIZE=5][COLOR=#006600][FONT=georgia][COLOR=#800000]!With [/COLOR][/FONT][/COLOR][COLOR=#006600][FONT=georgia]God [/FONT][/COLOR][COLOR=#006600][FONT=georgia][COLOR=#800000]all [/COLOR][/FONT][/COLOR][COLOR=#800000][FONT=georgia]things are [/FONT][/COLOR][COLOR=#006600][FONT=georgia]possible[/FONT][/COLOR][/SIZE][/B][B][FONT=Tahoma]
      [/FONT][/B][/CENTER]
      [CENTER][B][FONT=Tahoma] [IMG]http://forum.exceliran.com/attachment.php?attachmentid=5334&d=1419428336[/IMG]
      [/FONT][/B][SIZE=1][FONT=Tahoma][B][FONT=Tahoma]
      [/FONT][/B][/FONT][/SIZE]
      [/CENTER]

      کامنت

      • armey

        • 2019/11/08
        • 142
        • 38.00

        #4
        نوشته اصلی توسط حسام بحرانی
        سلام دوست عزیز
        برای رفع خطایی که عنوان کردید ( با اضافه شدن شیت خطا میده ) مسیر زیر رو بروید :
        کد HTML:
        Options > Trust Center > Trust Center Settings > Privacy Options
        سپس تیک زیر رو بردارید:
        کد HTML:
        Remove personal information from file properties on save
        موفق باشید.

        سپاس از شما دوست عزیز جناب بحرانی
        بزرگوار
        لطف کردید


        جسارتا امکانش هست بفرمایید
        چرا وقتی اسم شیت رو عوض میکنم
        و همون تغییر نام رو در کد اعمال میکنم
        خطا میدهد

        - - - Updated - - -

        سپاس از شما دوست عزیز جناب بحرانی
        بزرگوار
        لطف کردید


        جسارتا امکانش هست بفرمایید
        چرا وقتی اسم شیت رو عوض میکنم
        و همون تغییر نام رو در کد اعمال میکنم
        خطا میدهد

        کامنت

        • حسام بحرانی

          • 2013/09/29
          • 2065
          • 72.00

          #5
          فکر نمی کنم دیگه خطا بده
          امتحان کردید؟!
          موفق باشید.
          [CENTER][B][SIZE=5][COLOR=#006600][FONT=georgia][COLOR=#800000]!With [/COLOR][/FONT][/COLOR][COLOR=#006600][FONT=georgia]God [/FONT][/COLOR][COLOR=#006600][FONT=georgia][COLOR=#800000]all [/COLOR][/FONT][/COLOR][COLOR=#800000][FONT=georgia]things are [/FONT][/COLOR][COLOR=#006600][FONT=georgia]possible[/FONT][/COLOR][/SIZE][/B][B][FONT=Tahoma]
          [/FONT][/B][/CENTER]
          [CENTER][B][FONT=Tahoma] [IMG]http://forum.exceliran.com/attachment.php?attachmentid=5334&d=1419428336[/IMG]
          [/FONT][/B][SIZE=1][FONT=Tahoma][B][FONT=Tahoma]
          [/FONT][/B][/FONT][/SIZE]
          [/CENTER]

          کامنت

          • armey

            • 2019/11/08
            • 142
            • 38.00

            #6
            عرض ادب و احترام
            دوستان عزیز اعضای محترم

            از بیخ همه چی رو خراب کردم از اول ساختم

            این کدی نوشتم

            کد:
            Sub Print_Form_nasb()
            
            
            
            Dim x As Integer
            x = 2
            Do
            Call fill_form(x)
            Sheets("ÝÑã_äÕÈ").PrintOut
            x = x + 1
            Loop Until IsEmpty(Sheets("ÊÎÕíÕí_ÑæÒ").Cells(x, 1))
            
            
            End Sub
            
            
            Sub fill_form(x As Integer)
            
            
            Sheets("ÝÑã_äÕÈ").Shapes("TextBox 4").DrawingObject.Text = Sheets("ÊÎÕíÕí_ÑæÒ").Cells(x, 16)
            
            
            End Sub

            خوب خوب خوب فکر کنم خطا پیدا شد
            الان
            دیدم که تو محیط ویندوز و اکسل فارسی نوشته و دیده میشه و مشکلی نیست
            ولی وقتی خط دستور رو تو سایت کپی کردم دیدم حروف فارسی رو نمیاره مطابق عکس پیوست

            بعد رفتم تو فایلم همه اسمهای فارسی رو انگیلیسی کردم خطا برطرف شد

            پس مشکل از زبان فارسی سیستم ام هست یا ویندوز یا آفیس


            دوستان کسی این مشکل رو داشته تا حالا
            فایل های پیوست شده

            کامنت

            چند لحظه..