[حل شده] نیاز به کد نویسی جهت چاپ شیت های خاص بر اسا شرط های متغییر

[armey]

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

بزرگواران
بنده یک فایل جهت چاپ قرارداد دارم

روال بر این مدار است که
دستور نصب و قرارداد از طرف مرکز در سامانه ایی صادر میشود

ما خروجی سامانه را گرفته
در فایل اکسل کپی میکنیم

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

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

یعنی هر سطر یک قرارداد است که اطلاعاتش چاپ می شود
و میرود سراغ سطر بعدی
تا
رسیدن به سطر آخر (سطر خالی)


حالا تغییر جدیدی رخ داده


هر قرارداد با توجه به نوع دستگاه نیاز به فرم آموزش دارد


که فرم های آموزش در شیت های مجزا ذخیره شده(6 نوع آموزش)

***حالا کد مورد نیاز شامل این شرط می باشد که:
هر سطر (هرقرارداد) را که منتقل به فرم میکند جهت چاپ نوع دستگاه را ببیند و شیت مربوط را چاپ کند

سپس برود به سراغ سطر بعدی(قرارداد بعدی)



تخصیصی.zip


توضیح فایل :
*شیت اول "فرم قرارداد" فرم اصلی قرارداد که محل چاپ است
*شیت دوم "تخصیصی" اطلاعات قرارداد که خروجی سامانه است
*شیت سوم "انبار" اطلاعات محل هردستگاه در انبار است که وقتی قراردادی صادر میشود جهت نصب دستگاهی خاص آدرس محل دستگاه از این شیت یافت میشود
*******شیت چهارم "آدرس" در اینجا هر سطر مساوی با سطر تخصیصی"قرارداد" است فقط در ستون
"G"
تعیین کردم که هر قرارداد چه آموزشی نیاز دارد
یعنی مثلا سطر اول یا همان قرارداد اول برابر با سطر اول این شیت و سلول اول ستون"G" می باشد که باید آن آموزش چاپ شود

*بزرگواران این تغییر جدید که بنده را نیازمند این کد کرده واقعا وقت زیادی از مجموعه میگیرد و بشد رویه کاری را سخت و زمانبر کرده
از صمیم قلب سپاسگزار میشویم اگر کمک بفرمایید

[iranweld]

با سلام

نام شیت های مقصد را به لاتین تغییر بدید و کدهای ذیل را تکمیل کنید

If Sheets("takhsisi ruz").Cells(x, 7) = "Pax-D210" Then
Sheets("پکس ثابت").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNN" Then
Sheets("پکس سيار").PrintOut

End If 

[iranweld]

یا اینجا کدها رو اصلاح کنید

Sub Print_Form()

    Dim x As Integer  
  x = 2 
   Do  
  Call Fill_Form(x)
 
   Sheets("form nasb").PrintOut  

     If Sheets("takhsisi ruz").Cells(x, 7) = "Pax-D210" Then

Sheets("بکس ثابت").PrintOut

ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNN" Then

Sheets("بمس سيار").PrintOut

End If  

      x = x + 1      

  Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))

End Sub

[armey]

بزرگوار
تمام قد از لطف شما سپاسگزارم
بسیار بسیار بسیار کمک بزرگی کردید

[TABLE="width: 202"]
[TR]
[TD]Bitel_IC3100-SD[/TD]
[/TR]
[TR]
[TD]Bitel_IC3300[/TD]
[/TR]
[TR]
[TD]Bitel_IC5100[/TD]
[/TR]
[TR]
[TD]Bitel-IC3100[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-L2N[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-LNL[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-LNN[/TD]
[/TR]
[TR]
[TD]BlueBird_CT360[/TD]
[/TR]
[TR]
[TD]BlueBird_CT360-SB[/TD]
[/TR]
[TR]
[TD]BlueBird_MT280-L2L[/TD]
[/TR]
[TR]
[TD]BlueBird_MT280-L2N[/TD]
[/TR]
[TR]
[TD]BlueBird_MT360[/TD]
[/TR]
[TR]
[TD]BlueBird_MT760[/TD]
[/TR]
[TR]
[TD]BlueBird_P3500[/TD]
[/TR]
[TR]
[TD]Castles-MP200[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000-Lan[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000-WiFi+Lan[/TD]
[/TR]
[TR]
[TD]Castles-Vega5000S[/TD]
[/TR]
[TR]
[TD]Castles-Vega5000SE[/TD]
[/TR]
[TR]
[TD]Magic C5[/TD]
[/TR]
[TR]
[TD]Magic X5[/TD]
[/TR]
[TR]
[TD]Magic X8[/TD]
[/TR]
[TR]
[TD]Pax-A930[/TD]
[/TR]
[TR]
[TD]Pax-D210[/TD]
[/TR]
[TR]
[TD]Pax-Q80[/TD]
[/TR]
[TR]
[TD]Pax-S800[/TD]
[/TR]
[TR]
[TD]Spectra-SP530[/TD]
[/TR]
[TR]
[TD]unknown[/TD]
[/TR]
[TR]
[TD]VX520[/TD]
[/TR]
[/TABLE]

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

- - - Updated - - -

فقط آیا اینکه در آموزش از همان اسم (فارسی) استفاده کردید جهت آموز ما بوده یا به مورد دیگری مربوط است

[iranweld]

بزرگوار
تمام قد از لطف شما سپاسگزارم
بسیار بسیار بسیار کمک بزرگی کردید

[TABLE="width: 202"]
[TR]
[TD]Bitel_IC3100-SD[/TD]
[/TR]
[TR]
[TD]Bitel_IC3300[/TD]
[/TR]
[TR]
[TD]Bitel_IC5100[/TD]
[/TR]
[TR]
[TD]Bitel-IC3100[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-L2N[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-LNL[/TD]
[/TR]
[TR]
[TD]BlueBird_CT280-LNN[/TD]
[/TR]
[TR]
[TD]BlueBird_CT360[/TD]
[/TR]
[TR]
[TD]BlueBird_CT360-SB[/TD]
[/TR]
[TR]
[TD]BlueBird_MT280-L2L[/TD]
[/TR]
[TR]
[TD]BlueBird_MT280-L2N[/TD]
[/TR]
[TR]
[TD]BlueBird_MT360[/TD]
[/TR]
[TR]
[TD]BlueBird_MT760[/TD]
[/TR]
[TR]
[TD]BlueBird_P3500[/TD]
[/TR]
[TR]
[TD]Castles-MP200[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000-Lan[/TD]
[/TR]
[TR]
[TD]Castles-Vega3000-WiFi+Lan[/TD]
[/TR]
[TR]
[TD]Castles-Vega5000S[/TD]
[/TR]
[TR]
[TD]Castles-Vega5000SE[/TD]
[/TR]
[TR]
[TD]Magic C5[/TD]
[/TR]
[TR]
[TD]Magic X5[/TD]
[/TR]
[TR]
[TD]Magic X8[/TD]
[/TR]
[TR]
[TD]Pax-A930[/TD]
[/TR]
[TR]
[TD]Pax-D210[/TD]
[/TR]
[TR]
[TD]Pax-Q80[/TD]
[/TR]
[TR]
[TD]Pax-S800[/TD]
[/TR]
[TR]
[TD]Spectra-SP530[/TD]
[/TR]
[TR]
[TD]unknown[/TD]
[/TR]
[TR]
[TD]VX520[/TD]
[/TR]
[/TABLE]

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

- - - Updated - - -

فقط آیا اینکه در آموزش از همان اسم (فارسی) استفاده کردید جهت آموز ما بوده یا به مورد دیگری مربوط است

چون vb حرف "ي" عربی رو شناسایی میکنه و با "ی" فارسی مشکل داره ، به همین خاطر نام شیت ها رو لاتین کنید.

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

Sub Print_Form()
    Dim x As Integer

  x = 2

   Do

  Call Fill_Form(x) 

   Sheets("form nasb").PrintOut

Select Case Sheets("takhsisi ruz").Cells(x, 7)

Case "Bitel_IC3100 -SD"

Sheets("x1").PrintOut

Case "Bitel_IC3300"

Sheets("x2").PrintOut

Case "Bitel_IC5100"

Sheets("x3").PrintOut

Case "Bitel -IC3100"

Sheets("x4").PrintOut

Case "BlueBird_CT280 -L2N"

Sheets("x5").PrintOut


End Select

      x = x + 1

  Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))

End Sub 

[armey]

یا اینجا کدها رو اصلاح کنید

Sub Print_Form()

    Dim x As Integer  
  x = 2
   Do  
  Call Fill_Form(x)
 
   Sheets("form nasb").PrintOut  

     If Sheets("takhsisi ruz").Cells(x, 7) = "Pax-D210" Then

Sheets("بکس ثابت").PrintOut

ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNN" Then

Sheets("بمس سيار").PrintOut

End If  

      x = x + 1      

  Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))

End Sub

بزرگوار ضمن سپاس مجدد و بیکران

کد به حالت زیر درست شد و عملکرد

Sub Print_Form()

    Dim x As Integer
    x = 2
    Do
    Call Fill_Form(x)
    Sheets("form nasb").PrintOut
    x = x + 1
    Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))




End Sub






Sub Fill_Form(x As Integer)


Sheets("form nasb").Shapes("TextBox 49").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 22").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 18)
Sheets("form nasb").Shapes("TextBox 24").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 31)
Sheets("form nasb").Shapes("TextBox 84").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 16)
Sheets("form nasb").Shapes("TextBox 37").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 10").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 29)
Sheets("form nasb").Shapes("TextBox 8").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 25)
Sheets("form nasb").Shapes("TextBox 7").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 26)
Sheets("form nasb").Shapes("TextBox 26").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 23)
Sheets("form nasb").Shapes("TextBox 4").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 5)
Sheets("form nasb").Shapes("TextBox 59").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 1)
Sheets("form nasb").Shapes("TextBox 54").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 8)
Sheets("form nasb").Shapes("TextBox 47").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 7)
Sheets("form nasb").Shapes("TextBox 55").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 6)
Sheets("form nasb").Shapes("TextBox 2").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 28)
Sheets("form nasb").Shapes("TextBox 9").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 10)
Sheets("form nasb").Shapes("TextBox 23").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 19)
Sheets("form nasb").Shapes("TextBox 64").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 3").DrawingObject.Text = Sheets("adres").Cells(x, 2)
Sheets("form nasb").Shapes("TextBox 6").DrawingObject.Text = Sheets("adres").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 1").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 16)
Sheets("form nasb").Shapes("TextBox 11").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 14").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 15").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 26)
Sheets("form nasb").Shapes("TextBox 16").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 28)
Sheets("form nasb").Shapes("TextBox 17").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 6)
Sheets("form nasb").Shapes("TextBox 34").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 19)
Sheets("form nasb").Shapes("TextBox 19").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 11)
Sheets("form nasb").Shapes("TextBox 18").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 10)
Sheets("form nasb").Shapes("TextBox 20").DrawingObject.Text = Sheets("adres").Cells(x, 7)
Sheets("form nasb").Shapes("TextBox 25").DrawingObject.Text = Sheets("adres").Cells(x, 9)
Sheets("form nasb").Shapes("TextBox 35").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 29)


If Sheets("takhsisi ruz").Cells(x, 7) = "Pax-D210" Then
Sheets("PAX SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNN" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC3100-SD" Then
Sheets("BITLE SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC3300" Then
Sheets("BITLE SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC5100" Then
Sheets("BITLE SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-L2N" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNL" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT360" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT360-SB" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT280-L2L" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT280-L2N" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT360" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT760" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_P3500" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-MP200" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000-Lan" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000-WiFi+Lan" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega5000S" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega5000SE" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic C5" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic X5" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic X8" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-A930" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-Q80" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-S800" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Spectra-SP530" Then
Sheets("PAX SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "unknown" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "VX520" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel-IC3100" Then
Sheets("BITLE SABET").PrintOut


End If


End Sub

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

[iranweld]

کدهایی رو که نوشتید اینجا منتقل کنید یا در این کدها نام شیت و دستگاه رو ویرایش کنید.

در اینجا اول فرم نصب پرینت میشه بعد فرم آمورش

Sub Print_Form()
    Dim x As Integer

  x = 2

   Do

  Call Fill_Form(x) 

   Sheets("form nasb").PrintOut

Select Case Sheets("takhsisi ruz").Cells(x, 7)

Case "Bitel_IC3100 -SD"

Sheets("x1").PrintOut

Case "Bitel_IC3300"

Sheets("x2").PrintOut

Case "Bitel_IC5100"

Sheets("x3").PrintOut

Case "Bitel -IC3100"

Sheets("x4").PrintOut

Case "BlueBird_CT280 -L2N"

Sheets("x5").PrintOut


End Select

      x = x + 1

  Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))

End Sub 

[armey]

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

واقعا شرمنده

مورد آخر رو متوجه نشده

الان کد داره کامل کار مکینه

تمام سلول های شیت تخصیص درست به فرم منتقل میشن

سلول هفتم بررسی میشه و بر اساسش دستور چاپ میره

منتهی هدف چاپ فرم سپس آموزش است

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


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

Sub Print_Form()

    Dim x As Integer
    x = 2
    Do
    Call Fill_Form(x)
    Sheets("form nasb").PrintOut
    x = x + 1
    Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))




End Sub

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

Sub Fill_Form(x As Integer)


Sheets("form nasb").Shapes("TextBox 49").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 22").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 18)
Sheets("form nasb").Shapes("TextBox 24").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 31)
Sheets("form nasb").Shapes("TextBox 84").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 16)
Sheets("form nasb").Shapes("TextBox 37").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 10").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 29)
Sheets("form nasb").Shapes("TextBox 8").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 25)
Sheets("form nasb").Shapes("TextBox 7").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 26)
Sheets("form nasb").Shapes("TextBox 26").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 23)
Sheets("form nasb").Shapes("TextBox 4").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 5)
Sheets("form nasb").Shapes("TextBox 59").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 1)
Sheets("form nasb").Shapes("TextBox 54").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 8)
Sheets("form nasb").Shapes("TextBox 47").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 7)
Sheets("form nasb").Shapes("TextBox 55").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 6)
Sheets("form nasb").Shapes("TextBox 2").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 28)
Sheets("form nasb").Shapes("TextBox 9").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 10)
Sheets("form nasb").Shapes("TextBox 23").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 19)
Sheets("form nasb").Shapes("TextBox 64").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 3").DrawingObject.Text = Sheets("adres").Cells(x, 2)
Sheets("form nasb").Shapes("TextBox 6").DrawingObject.Text = Sheets("adres").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 1").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 16)
Sheets("form nasb").Shapes("TextBox 11").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 17)
Sheets("form nasb").Shapes("TextBox 14").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 3)
Sheets("form nasb").Shapes("TextBox 15").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 26)
Sheets("form nasb").Shapes("TextBox 16").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 28)
Sheets("form nasb").Shapes("TextBox 17").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 6)
Sheets("form nasb").Shapes("TextBox 34").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 19)
Sheets("form nasb").Shapes("TextBox 19").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 11)
Sheets("form nasb").Shapes("TextBox 18").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 10)
Sheets("form nasb").Shapes("TextBox 20").DrawingObject.Text = Sheets("adres").Cells(x, 7)
Sheets("form nasb").Shapes("TextBox 25").DrawingObject.Text = Sheets("adres").Cells(x, 9)
Sheets("form nasb").Shapes("TextBox 35").DrawingObject.Text = Sheets("takhsisi ruz").Cells(x, 29)

و این شرط چاپ راهنما

If Sheets("takhsisi ruz").Cells(x, 7) = "Pax-D210" Then
Sheets("PAX SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNN" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC3100-SD" Then
Sheets("BITLE SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC3300" Then
Sheets("BITLE SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel_IC5100" Then
Sheets("BITLE SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-L2N" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT280-LNL" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT360" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_CT360-SB" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT280-L2L" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT280-L2N" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT360" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_MT760" Then
Sheets("BLUEBIRD SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "BlueBird_P3500" Then
Sheets("BLUEBIRD SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-MP200" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000-Lan" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega3000-WiFi+Lan" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega5000S" Then
Sheets("CASTELS SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Castles-Vega5000SE" Then
Sheets("CASTELS SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic C5" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic X5" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Magic X8" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-A930" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-Q80" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Pax-S800" Then
Sheets("PAX SABET").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Spectra-SP530" Then
Sheets("PAX SAIAR").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "unknown" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "VX520" Then
Sheets("MAGIC").PrintOut
ElseIf Sheets("takhsisi ruz").Cells(x, 7) = "Bitel-IC3100" Then
Sheets("BITLE SABET").PrintOut


End If


End Sub

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

[LEFT][COLOR=#0000BB][FONT=monospace]Sub Print_Form[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim x [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Integer

  x [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2

   [/FONT][/COLOR][COLOR=#007700][FONT=monospace]Do

  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Call Fill_Form[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]x[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) 

   [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"form nasb"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut

Select [/FONT][/COLOR][COLOR=#007700][FONT=monospace]Case [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"takhsisi ruz"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Cells[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]x[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]7[/FONT][/COLOR][COLOR=#007700][FONT=monospace])

Case [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Bitel_IC3100 -SD"

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"x1"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut

[/FONT][/COLOR][COLOR=#007700][FONT=monospace]Case [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Bitel_IC3300"

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"x2"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut

[/FONT][/COLOR][COLOR=#007700][FONT=monospace]Case [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Bitel_IC5100"

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"x3"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut

[/FONT][/COLOR][COLOR=#007700][FONT=monospace]Case [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Bitel -IC3100"

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"x4"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut

[/FONT][/COLOR][COLOR=#007700][FONT=monospace]Case [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"BlueBird_CT280 -L2N"

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"x5"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]PrintOut


End Select

      x [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]x [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1

  Loop Until IsEmpty[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"takhsisi ruz"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Cells[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]x[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]))

[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End Sub [/FONT][/COLOR][/LEFT]

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

[armey]

بزرگوار حالا که شرمنده لطف شما شدم فرصت رو غنیمت ببینم یک سوال دیگه بپرسم

من از کد چاپ فرم نصب در جای دیگری برای چاپ فرمی دیگر استفاده کردم

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

بگم فقط سطر هایی رو ببر رو فرم نصب و چاپ بگیر که
مثلا سلول اول یا ایکسمش
دارای مقدار باشه (پر باشه ، دارای عدد یک باشه ) یا هر شرطی

[iranweld]

با سلام

بجای کد قبلی

Sub Print_Form()

    Dim x As Integer
  x = 2


   Do


  Call Fill_Form(x)


   Sheets("form nasb").PrintOut

      x = x + 1
  Loop Until IsEmpty(Sheets("takhsisi ruz").Cells(x, 1))



End Sub 

از این کد استفاده کنید
بجای

نام A ستون در

Range("A" & i)

و

z1 = Cells(Rows.Count, "A").End(xlUp).Row

نام ستون مورد نظر را وارد کنید

Sub Print_Form()

    Dim x As Integer

     z1 = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To z1

    If Sheets("takhsisi ruz").Range("A" & i) > 0 Then


     Call Fill_Form(x)


   Sheets("form nasb").PrintOut


End If


Next


End Sub