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

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

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

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

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


    به یک کد ویژوال دارم

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

    کد:
    Call Fill_Form(x)
    Sheets("crm-form").PrintOut
    این کار رو تا جایی انجام میده که سلول اول از سطر خالی شود

    کد:
     Loop Until IsEmpty(Sheets("crm").Cells(x, 3))
    یعنی
    کد:
    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))
    
End Sub




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



    کد:
    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))
    
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






[SIZE=2][COLOR=#b22222][B][/B][/COLOR][/SIZE]
    برچسب ها: هیچ‌کدام
    قبلی template بعدی
    چند لحظه..