PDA

View Full Version : يك گزارش گيري از دو Table



yshahab
سه شنبه 16 تیر 1388, 20:59 عصر
دوستان من در يك table شغل ها رو وارد كردم در table ديگه مشخصات به همراه شغل . حالا وقتي مي خوام در ديتا ريپورت گزارش از يك شغل خاص كه جستجو كردم بگيرم كه چه كسايي اين شغلو دارن به همراه مشخصات مشكلي پيش مي ياد كه از هر كدوم از اين افراد 2 بار نام ميبره . يعني 2 بار پشت سر هم نام يكنفر رو مي نويسه در حاليكه يكبار وارد كردم .:عصبانی++::عصبانی++:

mpmsoft
چهارشنبه 17 تیر 1388, 11:01 صبح
کدتو بذار چک کنیم

yshahab
چهارشنبه 17 تیر 1388, 11:09 صبح
اين ورودي اول :
Private Sub CmndSave_Click()

Dim OleDb As New ClassOleDb
Dim Cmnd As String
Cmnd = "INSERT INTO Basteh (Code1,Name,tool,arz,toolyo,arzyo,fee2,qu1,qu2) Values ('" & _
TxtCode.Text & "','" & _
Txtname.Text & "','" & _
Txttool.Text & "','" & _
txtarz.Text & "','" & _
txttoolyo.Text & "','" & _
txtarzyo.Text & "','" & _
Txtfee.Text & "','" & _
txtqu1.Text & "','" & _
txtqu2.Text & "')"

'// Run Query
If OleDb.ExecuteQuery(Cmnd) = True Then
MsgBox "ÚãáíÇÊ ÐÎíÑå ÓÇÒí ÈÇ ãæÝÞíÊ ÇäÌÇã ÔÏ", vbOKOnly
Unload Me
End If

'//Release Memory
Set OleDb = Nothing

End Sub

Private Sub XPButton1_Click()
Dim a, b, d, f, h, g As Long
Dim c As Double

b = CLng(Txttool.Text)
a = CLng(txtarz.Text)
d = CLng(txttoolyo.Text)
f = CLng(txtarzyo.Text)
h = CLng(txtqu1.Text)
g = CLng(txtqu2.Text)


c = ((((a * b) / 1000000) * 540) * h) + ((((d * f) / 1000000) * 150) * g)
Txtfee.Text = Int(c)
End Sub
اين ورودي دوم :


Private Sub CmndCalculate_Click()
'// Calculate Value(s)
Call Calculate
End Sub

Private Sub CmndSave_Click()

Dim OleDb As New ClassOleDb
Dim Cmnd As String
Cmnd = "INSERT INTO Piece (Code,Description,Process,Article,Filet,Width,Leng ht,Quantity,Quantity1,Width3,Width4,tolid,t0,t1,t2 ,t3,feeee,feenavar,feemadeh,QU,Tax) Values ('" & _
TxtBoxCode.Text & "','" & _
TxtBoxDescription.Text & "','" & _
Combobasteh.Text & "','" & _
CmboArticle.Text & "','" & _
CmboFilet.Text & "'," & _
TxtBoxWidth.Text & "," & _
TxtBoxLenght.Text & "," & _
TxtBoxQuantity.Text & "," & _
TxtBoxQuantity1.Text & "," & _
TxtBoxWidth3.Text & "," & _
TxtBoxWidth4.Text & "," & _
txt.Text & "," & _
total0.Text & "," & _
total1.Text & "," & _
total2.Text & "," & _
total3.Text & "," & _
TxtBoxTotalFee.Text & "," & _
TxtBoxFiletAmount.Text & "," & _
TxtBoxArticleAmount.Text & "," & _
txtqu.Text & "," & _
TxtBoxTax.Text & ")"

'// Run Query
If OleDb.ExecuteQuery(Cmnd) = True Then
MsgBox "ÚãáíÇÊ ÐÎíÑå ÓÇÒí ÈÇ ãæÝÞíÊ ÇäÌÇã ÔÏ", vbOKOnly
Unload Me
End If

'//Release Memory
Set OleDb = Nothing

End Sub

Private Sub Form_Load()
'// Load Captions
Call LoadFormCaption(Me)

'// Load ArticlesAndFilets
Call LoadArticlesAndFilets
End Sub

Sub LoadArticlesAndFilets()

Dim OleDb As New ClassOleDb
Dim rs As New Recordset
Dim Cmnd As String
Dim i&, j&



'// Load Available Article(s)

Cmnd = "SELECT * From Article"
Set rs = OleDb.Fill(Cmnd)


If Not (rs.EOF) Then

i = 0
rs.MoveFirst
Do
CmboArticle.AddItem rs.Fields("Type").Value

'// Move to next record
i = i + 1
rs.MoveNext
Loop Until rs.EOF

'// Select 1st Item
CmboArticle.ListIndex = 0

End If



'// Load Available Filet(s)

Cmnd = "SELECT * From Filet"
Set rs = OleDb.Fill(Cmnd)


If Not (rs.EOF) Then

i = 0
rs.MoveFirst
Do
CmboFilet.AddItem rs.Fields("Type").Value

'// Move to next record
i = i + 1
rs.MoveNext
Loop Until rs.EOF

'// Select 1st Item
CmboFilet.ListIndex = 0

End If

Cmnd = "SELECT * From Basteh "
Set rs = OleDb.Fill(Cmnd)


If Not (rs.EOF) Then

i = 0
rs.MoveFirst
Do
Combobasteh.AddItem rs.Fields("Name").Value

'// Move to next record
i = i + 1
rs.MoveNext
Loop Until rs.EOF

'// Select 1st Item
CmboFilet.ListIndex = 0
Combobasteh.ListIndex = 0
End If



'//Release Memory
Set rs = Nothing
Set OleDb = Nothing

End Sub

Sub Calculate()

On Error GoTo ErrHandler

Dim OleDb As New ClassOleDb
Dim rs As New Recordset
Dim Cmnd As String



'// Calculate Value(s)

Dim ArticleAmount, FiletAmount, mb, mn, ms, msh, majmoo As Double
Dim Width, Width3, Width4, Lenght, Quantity, Quantity1, Quantity3, Quantity4, Quantity5, tolid As Long

Width = CLng(TxtBoxWidth.Text)

Width3 = CLng(TxtBoxWidth3.Text)
Width4 = CLng(TxtBoxWidth4.Text)
Lenght = CLng(TxtBoxLenght.Text)
Quantity = CLng(TxtBoxQuantity.Text)
Quantity1 = CLng(TxtBoxQuantity1.Text)
tolid = CLng(txt.Text)

mb = ((Width * 2) + (Lenght * 2)) * 2
mn = (3000 * ((Width * Quantity) + (Lenght * Quantity1))) / 1000
ms = 1500 * Width3
msh = 2000 * Width4
majmoo = ((((Width * 2) + (Lenght * 2)) * 2) + (mn) + (1500 * Width3) + (2000 * Width4))
ArticleAmount = ((Width * Lenght) / 1000000) * (txtqu.Text)
FiletAmount = (((Width * Quantity) + (Lenght * Quantity1)) / 1000) * (txtqu.Text)

TxtBoxArticleAmount.Text = Abs(ArticleAmount)
TxtBoxFiletAmount.Text = Abs(FiletAmount)
total0.Text = Int(mb)
total1.Text = Int(mn)
total2.Text = Int(ms)
total3.Text = Int(msh)
txt.Text = Int(majmoo)








'// Load Selected Article Fee

Dim ArticleFee As Double

Cmnd = "SELECT * From Article WHERE Type='" & CmboArticle.Text & "'"
Set rs = OleDb.Fill(Cmnd)

ArticleFee = rs.Fields(1).Value



'// Load Selected Filet Fee

Dim FiletFee As Double

Cmnd = "SELECT * From Filet WHERE Type='" & CmboFilet.Text & "'"
Set rs = OleDb.Fill(Cmnd)

FiletFee = rs.Fields(1).Value





'// Calculate Total Fee

Dim TotalFee As Double
TotalFee = ((ArticleAmount * ArticleFee) + (mb) + (mn) + (ms) + (msh) + (FiletAmount * FiletFee) + CLng(Val(TxtBoxTax.Text))) * (txtqu.Text)

TxtBoxTotalFee.Text = Abs(TotalFee)



'//Release Memory
Set rs = Nothing
Set OleDb = Nothing

Exit Sub

ErrHandler:
MsgBox "ÇÔßÇá ÏÑ æÑæÏí ÇØáÇÚÇÊ ÑÇ ÈÑÑÓí æ ÑÝÚ äãÇÆíÏ", vbOKOnly

End Sub



اين هم فرم جستجو :


Private Sub Command1_Click()
Adodc36.RecordSource = "SELECT Piece.*,Basteh.* FROM Piece,Basteh where Name='" & Text1.Text & "'"
Adodc36.Refresh
Set DataReport10.DataSource = Adodc36

DataReport10.Show 1, Me
End Sub

Private Sub Form_Load()
Adodc36.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\DB.mdb"

End Sub

ayub_coder
چهارشنبه 17 تیر 1388, 17:59 عصر
حتما برای دو جدول یک کد منحصر به فرد ساختی که برای شغل باشه پس باید در قسمت شرط کد شغل رو برابر کد شغل در جدول مشخصات قرار بدی تا از تکرار جلوگیری بشه:متفکر: