نیازمند کد ماکرو - اجرا با شرطی خاص

Collapse
X
Collapse
 
  • صفحه از 1
  • زمان
  • نمایش
حذف همه
new posts
قبلی template بعدی
  • armey

    • 2019/11/08
    • 142
    • 38.00
    #1

    پرسش نیازمند کد ماکرو - اجرا با شرطی خاص

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

    این دستور میگوید
    سطرها ها را تا رسیدن به اولین سلول خالی دنبال کن
    و بابت هر سطر
    دستور را اجرا کن
    کد:
    Sub Print_Form_CRM()

    Dim x As Integer
    x = 2
    Do
    Call Fill_Form(x)
    Sheets("crm-form").PrintOut
    x = x + 4
    
    Loop Until IsEmpty(Sheets("crm").Cells(x, 3))


    کد:
     Loop Until IsEmpty(Sheets("crm").Cells(x, 3))

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

    - - - Updated - - -

    کد هر سطر را به فرمی خاص میبرد می چاپ میکند

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


    میخوام بگم کل شیت رو نگاه کن
    در ستون سوم یا همون ایکس سه
    اگر محتوایی بود دستور را برای آن سطر اجرا کن

    یا بگم

    اگر عدد یک داشت دستور را برای آن سطر اجرا کن
    برچسب ها: هیچ‌کدام
    • iranweld

      • 2015/03/29
      • 3341
      #2
      با سلام

      این کد را تست کنید


      کد PHP:
      Sub Print_Form_CRM()
                Dim x As Integer  
        x       = 2 
               Do

           If       Sheets("crm").Cells(x, 3) = 1 Then

         Call Fill_Form      (x)  
       
       
               Sheets("crm-form").PrintOut  
       
         End       If
       
                     x = x + 4   
           Loop Until IsEmpty      (Sheets("crm").Cells(x, 3)) 

        کامنت

        • armey

          • 2019/11/08
          • 142
          • 38.00
          #3
          نوشته اصلی توسط iranweld
          با سلام

          این کد را تست کنید


          کد PHP:
          Sub Print_Form_CRM()
                        Dim x As Integer  
            x           = 2 
                       Do

               If           Sheets("crm").Cells(x, 3) = 1 Then

             Call Fill_Form          (x)  
           
           
                       Sheets("crm-form").PrintOut  
           
             End           If
           
                             x = x + 4   
               Loop Until IsEmpty          (Sheets("crm").Cells(x, 3)) 


          ضمن عرض ادب و احترام

          سپاس از لطف شما بابت پاسختون

          این خطا رو میده

          compile error:
          loop without do

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

          کل این خط هم که پاک میکنم

          کد:
           Loop Until IsEmpty(Sheets("crm").Cells(x, 3))
          مینویسه

          compile error :
          block if without end if


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

          - - - Updated - - -

          کد:
          Sub Print_Form_CRM()

    Dim x As Integer
    x = 2
    Do
     If Sheets("crm").Cells(x, 8) = 1 Then
     
    Call Fill_Form(x)
    Sheets("crm-form").PrintOut
    x = x + 4
    
      Loop Until IsEmpty(Sheets("crm").Cells(x, 3))
    
End Sub



Sub Fill_Form(x As Integer)


Sheets("crm-form").Shapes("TextBox 2").DrawingObject.Text = Sheets("crm").Cells(x, 1)
Sheets("crm-form").Shapes("TextBox 3").DrawingObject.Text = Sheets("crm").Cells(x, 4)
Sheets("crm-form").Shapes("TextBox 5").DrawingObject.Text = Sheets("crm").Cells(x, 5)
Sheets("crm-form").Shapes("TextBox 6").DrawingObject.Text = Sheets("crm").Cells(x, 7)
Sheets("crm-form").Shapes("TextBox 7").DrawingObject.Text = Sheets("crm").Cells(x, 10)
Sheets("crm-form").Shapes("TextBox 12").DrawingObject.Text = Sheets("crm").Cells(x, 11)
Sheets("crm-form").Shapes("TextBox 8").DrawingObject.Text = Sheets("crm").Cells(x, 6)
Sheets("crm-form").Shapes("TextBox 9").DrawingObject.Text = Sheets("crm").Cells(x, 3)
Sheets("crm-form").Shapes("TextBox 10").DrawingObject.Text = Sheets("crm").Cells(x, 12)
Sheets("crm-form").Shapes("TextBox 11").DrawingObject.Text = Sheets("crm").Cells(x, 13)
Sheets("crm-form").Shapes("TextBox 13").DrawingObject.Text = Sheets("crm").Cells(x, 15)
Sheets("crm-form").Shapes("TextBox 19").DrawingObject.Text = Sheets("crm").Cells(x + 1, 1)
Sheets("crm-form").Shapes("TextBox 20").DrawingObject.Text = Sheets("crm").Cells(x + 1, 4)
Sheets("crm-form").Shapes("TextBox 21").DrawingObject.Text = Sheets("crm").Cells(x + 1, 5)
Sheets("crm-form").Shapes("TextBox 22").DrawingObject.Text = Sheets("crm").Cells(x + 1, 7)
Sheets("crm-form").Shapes("TextBox 23").DrawingObject.Text = Sheets("crm").Cells(x + 1, 10)
Sheets("crm-form").Shapes("TextBox 24").DrawingObject.Text = Sheets("crm").Cells(x + 1, 11)
Sheets("crm-form").Shapes("TextBox 25").DrawingObject.Text = Sheets("crm").Cells(x + 1, 6)
Sheets("crm-form").Shapes("TextBox 26").DrawingObject.Text = Sheets("crm").Cells(x + 1, 3)
Sheets("crm-form").Shapes("TextBox 27").DrawingObject.Text = Sheets("crm").Cells(x + 1, 12)
Sheets("crm-form").Shapes("TextBox 28").DrawingObject.Text = Sheets("crm").Cells(x + 1, 13)
Sheets("crm-form").Shapes("TextBox 29").DrawingObject.Text = Sheets("crm").Cells(x + 1, 15)
Sheets("crm-form").Shapes("TextBox 30").DrawingObject.Text = Sheets("crm").Cells(x + 2, 1)
Sheets("crm-form").Shapes("TextBox 31").DrawingObject.Text = Sheets("crm").Cells(x + 2, 4)
Sheets("crm-form").Shapes("TextBox 32").DrawingObject.Text = Sheets("crm").Cells(x + 2, 5)
Sheets("crm-form").Shapes("TextBox 33").DrawingObject.Text = Sheets("crm").Cells(x + 2, 7)
Sheets("crm-form").Shapes("TextBox 34").DrawingObject.Text = Sheets("crm").Cells(x + 2, 10)
Sheets("crm-form").Shapes("TextBox 35").DrawingObject.Text = Sheets("crm").Cells(x + 2, 11)
Sheets("crm-form").Shapes("TextBox 36").DrawingObject.Text = Sheets("crm").Cells(x + 2, 6)
Sheets("crm-form").Shapes("TextBox 37").DrawingObject.Text = Sheets("crm").Cells(x + 2, 3)
Sheets("crm-form").Shapes("TextBox 38").DrawingObject.Text = Sheets("crm").Cells(x + 2, 12)
Sheets("crm-form").Shapes("TextBox 39").DrawingObject.Text = Sheets("crm").Cells(x + 2, 13)
Sheets("crm-form").Shapes("TextBox 40").DrawingObject.Text = Sheets("crm").Cells(x + 2, 15)
Sheets("crm-form").Shapes("TextBox 41").DrawingObject.Text = Sheets("crm").Cells(x + 3, 1)
Sheets("crm-form").Shapes("TextBox 51").DrawingObject.Text = Sheets("crm").Cells(x + 3, 15)
Sheets("crm-form").Shapes("TextBox 42").DrawingObject.Text = Sheets("crm").Cells(x + 3, 4)
Sheets("crm-form").Shapes("TextBox 43").DrawingObject.Text = Sheets("crm").Cells(x + 3, 5)
Sheets("crm-form").Shapes("TextBox 44").DrawingObject.Text = Sheets("crm").Cells(x + 3, 7)
Sheets("crm-form").Shapes("TextBox 45").DrawingObject.Text = Sheets("crm").Cells(x + 3, 10)
Sheets("crm-form").Shapes("TextBox 46").DrawingObject.Text = Sheets("crm").Cells(x + 3, 11)
Sheets("crm-form").Shapes("TextBox 47").DrawingObject.Text = Sheets("crm").Cells(x + 3, 6)
Sheets("crm-form").Shapes("TextBox 48").DrawingObject.Text = Sheets("crm").Cells(x + 3, 3)
Sheets("crm-form").Shapes("TextBox 49").DrawingObject.Text = Sheets("crm").Cells(x + 3, 12)
Sheets("crm-form").Shapes("TextBox 50").DrawingObject.Text = Sheets("crm").Cells(x + 3, 13)

End Sub

            کامنت

            • iranweld

              • 2015/03/29
              • 3341
              #4
              ظاهرا یک خط از کد ارسالی بنده را حذف کرده اید

              Click image for larger version Name: Untitled.png Views: 1 Size: 41.2 کیلو بایت ID: 138811

                کامنت

                • armey

                  • 2019/11/08
                  • 142
                  • 38.00
                  #5
                  نوشته اصلی توسط iranweld
                  ظاهرا یک خط از کد ارسالی بنده را حذف کرده اید

                  [ATTACH=CONFIG]22721[/ATTACH]

                  عرض ادب خدمت شما دوست بزرگوار
                  از وقت و علمی که بذل میفرمایید به جد سپاسگذارم

                  متاسفانه حجم آپلودم پر شده و نمیدونم چجوری میتونم خالیش کنم
                  پوزش بنده رو بپذیرید که مجبورم در سایتی دیگر فایلهارو آپلود کنم

                  این فایل اصلی خودم هست اگر تمایل داشتید منت بزارید بررسی بفرماییدhttps://s18.picofile.com/file/843541...00312.zip.html

                  دستوری که در نهایت نوشتم شد این :
                  کد:
                  Sub Print_Form_CRM()

    Dim x As Integer
    
    x = 2
    
    Do
    
    If Sheets("crm").Cells(x, 8) = 1 Then
         
    Call Fill_Form(x)
    
    
    Sheets("crm-form").PrintOut
    
    End If
    
    x = x + 4
    
      Loop Until IsEmpty(Sheets("crm").Cells(x, 3))
    
End Sub
                  این صفحه سورس می باشد
                  https://s19.picofile.com/file/8435414576/2021_06_02_20_52_21.jpg


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


                  ولی محصول شد ردیف یک تا دوازده !!

                  https://s18.picofile.com/file/8435414592/2021_06_02_20_58_16.jpg



                  https://s18.picofile.com/file/8435414626/2021_06_02_20_58_09.jpg

                    کامنت

                    • armey

                      • 2019/11/08
                      • 142
                      • 38.00
                      #6
                      دوستان عزیز اعضای محترم بسیار سپاسگزارمیشوم اگر لطف کنید و راهنمایی بفرمایید

                        کامنت

                        قبلی template بعدی
                        چند لحظه..