فقط یک رکورد

یکی از دوستان برنامه ای به زبان vb نوشته ومشکلی داشت که به من که دلفی کار
کردم گفت مشکل ان این است که ان می خواهد عددی که در یک تکست باکس وارد می شود
ومربوط به یک فیلد از رکوردهای جدول است را جستجو کند و رکورد مربوطه را پیدا کند
و بعد در منو پرینت با زدن ان گزارش از ان گرفته شود و برای چاپ برود مشکل این است
که همه چیز درست است جز اینکه در صفحه گزارش به جای اینکه فقط رکورد مربوطه برای چاپ ارسال شود
تمام رکوردهای جدول می اید برای چاپ چه باید کرد من سورس
برنامه را می گذارم که بازدن منو پرینت و میانبر اف پنج برای چاپ گزارش گرفته می شود
این یک مطلب یک مطلب دیگه هم است ان اینه که می خواهد برنامه طوری باشد که به جای اینکه یک
شماره را هردفعه وارد تکست باکس کنیم ویکی یکی گزارش گرفته شود طوری شود که چند تایی انجام
شود که به نظر من باید یک شی مخصوص در vb گذاشته شود که اعداد که مربوط به فیلد ان است را
بگیرد ورکوردهای انها را پیدا کند وبرای گزارش بفرستد
باتشکر
VERSION 5.00
Begin VB.Form Menu
BackColor = &H00FFFFC0&
BorderStyle = 1 'Fixed Single
Caption = " ليست دستگاههاي POS پارسان ( نمايندگي قم )"
ClientHeight = 4845
ClientLeft = 1815
ClientTop = 2100
ClientWidth = 7305
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
NegotiateMenus = 0 'False
RightToLeft = -1 'True
ScaleHeight = 85.461
ScaleMode = 6 'Millimeter
ScaleWidth = 128.852
Begin VB.ComboBox CH1
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 510
ItemData = "Form1.frx":0FC2
Left = 120
List = "Form1.frx":0FDB
RightToLeft = -1 'True
TabIndex = 3
Top = 3600
Width = 2175
End
Begin VB.TextBox Serisl
BackColor = &H80000006&
BeginProperty Font
Name = "B Zar"
Size = 15.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000005&
Height = 525
Left = 1680
RightToLeft = -1 'True
TabIndex = 1
Top = 120
Width = 2055
End
Begin VB.CommandButton SerchT
Caption = "جستجو"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 525
Left = 240
RightToLeft = -1 'True
TabIndex = 2
Top = 120
Width = 1095
End
Begin VB.TextBox Toz
Alignment = 1 'Right Justify
DataField = "9"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
RightToLeft = -1 'True
TabIndex = 14
Top = 4200
Width = 5595
End
Begin VB.TextBox p1
DataField = "a2"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4080
RightToLeft = -1 'True
TabIndex = 7
Top = 600
Width = 1515
End
Begin VB.TextBox NF
Alignment = 1 'Right Justify
DataField = "3"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 2640
TabIndex = 8
Top = 1080
Width = 2955
End
Begin VB.TextBox MOrad
Alignment = 1 'Right Justify
DataField = "7"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 120
TabIndex = 12
Top = 3000
Width = 5595
End
Begin VB.TextBox Sabt
Alignment = 1 'Right Justify
DataField = "8"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 2400
TabIndex = 13
Top = 3600
Width = 3315
End
Begin VB.TextBox Form88
DataField = "10"
DataSource = "DataCOM110"
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 120
TabIndex = 5
Top = 1560
Width = 1275
End
Begin VB.TextBox s1
DataField = "a1"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4080
TabIndex = 6
Top = 120
Width = 1515
End
Begin VB.TextBox Date1
DataField = "11"
DataSource = "DataCOM110"
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 120
TabIndex = 4
Top = 1080
Width = 1275
End
Begin VB.TextBox Tel
DataField = "4"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000002&
Height = 465
Left = 2640
TabIndex = 9
Top = 1560
Width = 2955
End
Begin VB.TextBox LastName
Alignment = 1 'Right Justify
DataField = "5"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 1800
TabIndex = 10
Top = 2040
Width = 3555
End
Begin VB.Data DataCOM110
Caption = "Data COM110"
Connect = "Access"
DatabaseName = "D:\POS110\COM110.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 178
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 120
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "COM110"
Top = 720
Visible = 0 'False
Width = 2535
End
Begin VB.TextBox Adras
Alignment = 1 'Right Justify
DataField = "6"
DataSource = "DataCOM110"
Enabled = 0 'False
BeginProperty Font
Name = "B Zar"
Size = 12
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 435
Left = 120
TabIndex = 11
Top = 2520
Width = 6435
End
Begin VB.Label TOZEH
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "توضيحات:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5760
RightToLeft = -1 'True
TabIndex = 24
Top = 4320
Width = 765
End
Begin VB.Label SP1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "شماره پايانه:"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5640
RightToLeft = -1 'True
TabIndex = 23
Top = 720
Width = 1200
End
Begin VB.Label NF1
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":نام فروشگاه"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5640
TabIndex = 22
Top = 1200
Width = 1215
End
Begin VB.Label AdrsMahalKar
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":مورد اضهار شده"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5760
TabIndex = 21
Top = 3120
Width = 1335
End
Begin VB.Label NSK
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":نام ثبت کننده"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5880
TabIndex = 20
Top = 3720
Width = 1095
End
Begin VB.Label FOR
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":شماره فرم"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1440
TabIndex = 19
Top = 1560
Width = 1095
End
Begin VB.Label SN
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":شماره سريال"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5640
TabIndex = 18
Top = 240
Width = 1335
End
Begin VB.Label TAREKH
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":تاريخ"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1560
TabIndex = 17
Top = 1200
Width = 495
End
Begin VB.Label TelM1TEXT
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":تلفن "
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5640
TabIndex = 16
Top = 1680
Width = 540
End
Begin VB.Label LastNameTEXT
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ": نام و نام خانوادگي"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5400
TabIndex = 15
Top = 2160
Width = 1755
End
Begin VB.Label NameTEXT
AutoSize = -1 'True
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = ":آدرس"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6600
TabIndex = 0
Top = 2520
Width = 600
End
Begin VB.Menu cmdPrint /////////////////////////////
Caption = "امکانات"
Begin VB.Menu PrintOK
Caption = "Print"
Shortcut = {F5}
End
Begin VB.Menu AboutM
Caption = "درباره"
Shortcut = {F1}
End
End
End
Attribute VB_Name = "Menu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub List1_Click()
End Sub
Private Sub AboutM_Click()
About.Show
End Sub
Private Sub PrintOK_Click()
Sabt.Text = CH1.Text
DataReport1.Show
End Sub
Private Sub SerchT_Click()
Dim f1 As Variant
Dim a, bb(1 To 2) As String
Dim ii As Integer
bb(1) = "a1 LIKE"
bb(2) = "a2 LIKE"
f1 = CVar(Serisl.Text)
If f1 = "" Then
Exit Sub
Else
f1 = "'" & f1 & "'"
End If
d:
If ii = 2 Then
GoTo j
End If
ii = ii + 1
With Me.DataCOM110.Recordset
a = .Bookmark
.FindFirst bb(ii) & f1
If .NoMatch = True Then
GoTo d
j:
If .NoMatch = True Then
.Bookmark = a
MsgBox "شخص مورد نظر يافت نشد.", vbCritical, "Find Error"
End If
End If
End With
Dim texta2, m, r, n, k, d, h, l, p, z, b As String
Dim i, t As Integer
n = Day(Date)
m = Month(Date)
Select Case m
Case "1"
d = 0 + n
Case "2"
d = 31 + n
Case "3"
d = 59 + n
Case "4"
d = 90 + n
Case "5"
d = 120 + n
Case "6"
d = 151 + n
Case "7"
d = 181 + n
Case "8"
d = 212 + n
Case "9"
d = 243 + n
Case "10"
d = 273 + n
Case "11"
d = 304 + n
Case "12"
d = 334 + n
End Select
h = (Year(Date) - 624) / 4
While h >= 1
h = h - 1
l = l + 1
Wend
If h = 0 Then
b = 1
Else
b = 0
End If
k = (((Year(Date) - 621) * 365) + l) + (d - 79) + b
jj = (k - l) Mod 365
p = (k - l) / 365
ta = Mid(p, 3, 2)
If b = 1 Then
If jj = 0 Then
jj = 365
jj = 364
End If
For i = 1 To 2
If jj > 336 Then
texta2 = 12
jj = jj - 335
Exit For
ElseIf jj > 305 Then
texta2 = 11
jj = jj - 305
Exit For
ElseIf jj > 276 Then
texta2 = 10
jj = jj - 276
Exit For
ElseIf jj > 246 Then
texta2 = 9
jj = jj - 246
Exit For
ElseIf jj > 216 Then
texta2 = 8
jj = jj - 216
Exit For
ElseIf jj > 186 Then
texta2 = 7
jj = jj - 186
Exit For
ElseIf jj > 155 Then
texta2 = 6
jj = jj - 155
Exit For
ElseIf jj > 124 Then
texta2 = 5
jj = jj - 124
Exit For
ElseIf jj > 93 Then
texta2 = 4
jj = jj - 93
Exit For
ElseIf jj > 62 Then
texta2 = 3
jj = jj - 62
Exit For
ElseIf jj > 31 Then
texta2 = 2
jj = jj - 31
Exit For
Else
texta2 = 1
jj = jj
Exit For
End If
Next i
Else
If jj = 0 Then
jj = 365
jj = jj - 364
End If
For t = 1 To 2
If jj > 335 Then
texta2 = 12
jj = jj - 336
Exit For
ElseIf jj > 305 Then
texta2 = 11
jj = jj - 305
Exit For
ElseIf jj > 276 Then
texta2 = 10
jj = jj - 276
Exit For
ElseIf jj > 246 Then
texta2 = 9
jj = jj - 246
Exit For
ElseIf jj > 216 Then
texta2 = 8
jj = jj - 216
Exit For
ElseIf jj > 186 Then
texta2 = 7
jj = jj - 186
Exit For
ElseIf jj > 155 Then
texta2 = 6
jj = jj - 155
Exit For
ElseIf jj > 124 Then
texta2 = 5
jj = jj - 124
Exit For
ElseIf jj > 93 Then
texta2 = 4
jj = jj - 93
Exit For
ElseIf jj > 62 Then
texta2 = 3
jj = jj - 62
Exit For
ElseIf jj > 31 Then
texta2 = 2
jj = jj - 31
Exit For
Else
texta2 = 1
jj = jj
Exit For
End If
Next t
End If
Date1.Text = "13" & ta & "/" & texta2 & "/" & jj
Form88.Text = "88-"
End Sub
Private Sub WWWTapy_Change()
End Sub
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

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