Per Stenebo
2011-12-16 11:26:34
2019-11-10 20:28:49
MS Access 2003
cboLeverantör
Ändra datakälla till tblArbetsorder.alla + tblPerson.PersonID o Person + tblLeverantör.LeverantörID o Leverantör.
Ingen kontrollkälla för cboLeverantör.
VBA
Private Sub cboLeverantörID_AfterUpdate()
Dim sSQL As String
'Build the SQL query statement
sSQL = "SELECT PersonID, Person" & _
" FROM tblPerson" & _
" WHERE LeverantörID = " & Me.cboLeverantörID.Value & ";"
'Set the row source property of combo cboPersonID
Me.cboPersonID.RowSource = sSQL
'Refresh the form data
Me.cboPersonID.Requery
End Sub
Form Current
'Update cboPersonLevID
cboPersonLevID = DLookup("[LeverantörID]", "tblPerson", "[PersonID]= " & cboPersonID.Value & "")
'Update cboLeverantörID
cboLeverantörID = DLookup("[LeverantörID]", "tblLeverantör", "[LeverantörID]= " & cboPersonLevID.Value & "")
Herarki
- Skapa kolumn OrgMorID i tblMaskin.
- Kopiera Maskin sfrm till MaskinOrg_frm.
- Lägg till OrgMorID i källfråga.
- Lägg till cboOrgMorID.
- Skapa knappar KnappUpp, KnappHöger och KnappNer.
- Lägg till VB-kod för knappar.
- Skapa KnappMaskinOrg i menyn.
VB-kod
Private Sub KnappUpp_Click()
On Error GoTo Err_KnappUpp_Click
'cboOrgMorID should not be empty
If Not IsNull(Me.cboOrgMorID) Then
'Filter MaskinID by present OrgMorID
Me.Filter = "MaskinID = " & Me.cboOrgMorID
Me.FilterOn = True
End If
Exit_KnappUpp_Click:
Exit Sub
Err_KnappUpp_Click:
MsgBox Err.Description
Resume Exit_KnappUpp_Click
End Sub
Private Sub KnappHöger_Click()
On Error GoTo Err_KnappHöger_Click
If Not IsNull(Me.cboOrgMorID) Then
Me.Filter = "OrgMorID = " & Me.cboOrgMorID
Me.FilterOn = True
End If
Exit_KnappHöger_Click:
Exit Sub
Err_KnappHöger_Click:
MsgBox Err.Description
Resume Exit_KnappHöger_Click
End Sub
Private Sub KnappNer_Click()
On Error GoTo Err_KnappNer_Click
If Not IsNull(Me.cboMaskinID) Then
Me.Filter = "OrgMorID = " & Me.cboMaskinID
Me.FilterOn = True
End If
Exit_KnappNer_Click:
Exit Sub
Err_KnappNer_Click:
MsgBox Err.Description
Resume Exit_KnappNer_Click
End Sub
DoCmd.OpenForm
DoCmd.OpenForm "Employees", , ,"LastName = 'King'"
DoCmd.OpenForm "frmArbeteDetalj", , , "tblArbetsorder.ArbetsorderID = " & Me.cboArbetsorderID & ""
stLinkCriteria
Bygga komplicerade villkor för stLinkCriteria:
- Skapa en fråga (query) med aktuella villkor.
- Skifta till SQL-view (View > SQL-view).
- Kopiera allt mellan WHERE och ;
- Klista in efter stLinkCriteria = "
- Avsluta med "
- Hela satsen skall vara på samma rad.
- Ändra ev "text" till 'text'
- Spara och testa.
- Du behöver inte spara frågan, det är bara delar av SQL-koden vi vill ha.
Exempel (allt på samma rad):
stLinkCriteria = "(((tblBeskrivning.Intervallenhet) Is Not Null) AND ((tblArbetsorder.Slutdatum) Is Not Null) AND ((tblArbetsorder.NästaFörfallodag) field:
stLinkCriteria = "FieldA = " & variableA & " AND FieldB = ' " & variableB & " ' "
stLinkCriteria = "[tblLeverantör].[LeverantörID] = " & 71 & " And [Status] <> '" & "Slutförd" & "'"
ElseIf cboKostnad = 4 Then 'Visa bara kostnader senaste året
stLinkCriteria = "(((tblKostnad.Fakturadatum) BETWEEN #2008-06-01# AND #2009-06-01#))"
GoTo Open_form:
stLinkCriteria = "(((tblKostnad.Fakturadatum) BETWEEN #2009-01-01# AND #2009-12-31#) AND (tblKostnad.KontoID) NOT IN (1, 18, 19))"
Filter
Me.Filter = "MaskinID = " & Me.cboOrgMorID
Me.FilterOn = True
Forms!frmArbete.OrderBy = "tblBeskrivning.BeskrivningID DESC"
Forms!frmArbete.OrderByOn = True
Forms!frmArbete.Filter = ""
Forms!frmArbete.FilterOn = False
((Not tblArbetsorder.Status="Slutförd"))
(((Not qryKostnad2.Status="Utfall"))) AND ((qryKostnad2.Fakturadatum Is Not Null))
((((Lookup_cboLeverantörID.Leverantör="Conveyorteknik"))) AND ((Not qryKostnad2.Status="Utfall"))) AND ((qryKostnad2.FakturaNr Is Null))
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
DoCmd.ApplyFilter , "star1 like '*" & Me.txt_Search_Criteria.Value &
"*' Or star2 like '*" & Me.txt_Search_Criteria.Value & "*'"
Villkor
Är Null
<>"Slutförd"
<>71 OCH <>10
SQL
databasedev.co.uk/sql-multiple-conditions
SELECT tblBeskrivning.BeskrivningID, tblBeskrivning.Arbetstyp, tblBeskrivning.Åtgärd, tblArbetsorder.ArbetsorderID, tblObjekt.ObjektID, tblObjekt.Benämning, tblObjekt.FunkMorID, tblArbetsorder.Notering, tblArbetsorder.PersonID, tblArbetsorder.Status, tblArbetsorder.Prioritet, tblArbetsorder.Slutdatum, tblLeverantör.LeverantörID, tblLeverantör.Leverantör, tblPerson.Person FROM tblObjekt INNER JOIN (tblLeverantör INNER JOIN (tblBeskrivning INNER JOIN (tblArbetsorder INNER JOIN tblPerson ON tblArbetsorder.PersonID = tblPerson.PersonID) ON tblBeskrivning.BeskrivningID = tblArbetsorder.BeskrivningID) ON tblLeverantör.LeverantörID = tblPerson.LeverantörID) ON tblObjekt.ObjektID = tblBeskrivning.ObjektID WHERE (((tblArbetsorder.Slutdatum) Is Null) AND ((tblLeverantör.LeverantörID)<>71 And (tblLeverantör.LeverantörID)<>10)) OR (((tblArbetsorder.Status)<>"Slutförd") AND ((tblLeverantör.LeverantörID)<>71 And (tblLeverantör.LeverantörID)<>10)) ORDER BY tblArbetsorder.Prioritet;
$query = 'SELECT tblLeverantör.Leverantör, tblKostnad.Status, tblKostnad.SummaExlMoms, tblKonto.Kontonr, tblBeskrivning.Projekt, tblKostnad.StatusTid
FROM tblLeverantör INNER JOIN (tblBeskrivning INNER JOIN (tblArbetsorder INNER JOIN (tblKostnad INNER JOIN tblKonto ON tblKostnad.KontoID = tblKonto.KontoID) ON tblArbetsorder.ArbetsorderID = tblKostnad.ArbetsorderID) ON tblBeskrivning.BeskrivningID = tblArbetsorder.BeskrivningID) ON tblLeverantör.LeverantörID = tblKostnad.LeverantörID
WHERE (((tblKostnad.Status)<>"Utfall"))
ORDER BY tblLeverantör.Leverantör, tblKostnad.SummaExlMoms DESC';
Hämta värden
Refer to Form and Subform properties and controls
Hämtar värden från två andra (öppna) formulär.
-Sätt "Tillåt tillägg" till Nej för målformuläret.
-Kolla att namnen är korrekta för källfälten; cboxxx.
-KnappNy som tillåter tillägg, hämtar MaskinID och ReservdelsID från öppna formulär, återställer nej för tillägg sedan.
-Funktionsbeskrivning på knappen.
Exempel
Private Sub KnappNy_Click()
On Error GoTo Err_KnappNy_Click
'test if source forms is open
If Not CurrentProject.AllForms("Reservdelar frm").IsLoaded Then
MsgBox "Formuläret Reservdelar frm är inte öppet eller är inte reservdelen fokuserad på det formuläret."
Else
If Not CurrentProject.AllForms("MaskinOrg_frm").IsLoaded Then
MsgBox "Formuläret MaskinOrg_frm är inte öppet, välj maskin att koppla."
Else
'Set add property to True (for now)
AllowAdditions = True
'Add new record
DoCmd.GoToRecord , , acNewRec
'Copy MaskinID to form: Forms!Mainform!ControlName
Me!cboMaskinID = Forms!MaskinOrg_frm!cboMaskinID
'Copy ReservdelID to form
Me![cboReservdelID] = Forms![Reservdelar frm]![Reservdelar sfrm]![cboReservdelID]
'Focus on field
Me![Info].SetFocus
'Set add property to False
AllowAdditions = False
End If
End If
Exit_KnappNy_Click:
Exit Sub
Err_KnappNy_Click:
MsgBox Err.Description
Resume Exit_KnappNy_Click
End Sub
Inaktivera knapp
Inaktiverar KnappNy vid ny post. Aktiverar när den sparats.
Exempel:
Private Sub Form_BeforeInsert(Cancel As Integer)
'Disable button.
Me!KnappNyAO.Enabled = False
End Sub
Private Sub Form_AfterInsert()
'Enable button.
Me!KnappNyAO.Enabled = True
End Sub
frmReservdelar
Skapa fälten MorID (tal) och HerarkiNr (text 255) i tblReservdelar.
Importera frmReservdelar.
Importera VBA-modul till frmReservdelar.
Variabler
Private Sub KnappNyMaskin_Click()
On Error GoTo Err_KnappNyMaskin_Click
'Declare variable
Dim XOrgMorID As String
'Set variable
XOrgMorID = cboOrgMorID.Value
'Set add property to True (for now)
Forms![MaskinOrg_frm].AllowAdditions = True
'Add new record
DoCmd.GoToRecord , , acNewRec
'Set OrgMorID to previous value
cboOrgMorID = XOrgMorID
Exit_KnappNyMaskin_Click:
Exit Sub
Err_KnappNyMaskin_Click:
MsgBox Err.Description
Resume Exit_KnappNyMaskin_Click
End Sub
sSQL datakälla
Private Sub cboLeverantörID_AfterUpdate()
Dim sSQL As String
'Build the SQL query statement
sSQL = "SELECT PersonID, Person" & _
" FROM tblPerson" & _
" WHERE LeverantörID = " & Me.cboLeverantörID.Value & ";"
'Set the row source property of combo cboPersonID
Me.cboPersonID.RowSource = sSQL
'Refresh the form data
Me.cboPersonID.Requery
End Sub
Nollvärden
Private Sub KnappNer_Click()
On Error GoTo Err_KnappNer_Click
'Slå upp underordnade maskiner
If Not IsNull(DLookup("[MaskinID]", "tblMaskin", "[OrgMorID]= " & cboMaskinID.Value & "")) Then
Me.Filter = "OrgMorID = " & Me.cboMaskinID
Me.FilterOn = True
Else
MsgBox "Det finns inga underordnade maskiner"
End If
Exit_KnappNer_Click:
Exit Sub
Err_KnappNer_Click:
MsgBox Err.Description
Resume Exit_KnappNer_Click
End Sub
MsgBox
'Visa text
MsgBox "Test1"
'Visa värdet av ett uttryck
MsgBox (cboAction)
'Visa värdet av en egenskap
MsgBox "OrderByOn property is " & Forms("Mailing List").OrderByOn
'Visa egenskaperna hos flera värden med radbrytning emellan:
MsgBox "OrderByOn property is " & Forms("frmArbete").OrderByOn & (Chr(13) & Chr(10)) & _
"OrderBy property is " & Forms("frmArbete").OrderBy & (Chr(13) & Chr(10)) & _
"FilterOn property is " & Forms("frmArbete").FilterOn & (Chr(13) & Chr(10)) & _
"Filter property is " & Forms("frmArbete").Filter
'Skräddarsydd MsgBox
Dim msg As String
Dim title As String
Dim style As MsgBoxStyle
Dim response As MsgBoxResult
msg = "Do you want to continue?" ' Define message.
style = MsgBoxStyle.DefaultButton2 Or _
MsgBoxStyle.Critical Or MsgBoxStyle.YesNo
title = "MsgBox Demonstration" ' Define title.
' Display message.
response = MsgBox(msg, style, title)
If response = MsgBoxResult.Yes Then ' User chose Yes.
' Perform some action.
Else
' Perform some other action.
End If
'Skräddarsydd MsgBox med variabler, trunkerad text och radbrytning:
Dim Msg, Style, Title
Msg = "Vill du koppla [" & Left(Me.boxÅtgärd, 40) & "...]" & (Chr(13) & Chr(10)) & " till [" & Forms!frmMaskinNav.cboBenämning & "] ?"
Style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "Koppla arbete till maskin"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' User choose Yes.
'Copy MaskinID to form: Forms!Mainform!ControlName
Me.boxMaskinID = Forms!frmMaskinNav.boxMaskinID
'Reset unbound fields
Me.boxOrgMorBenämning = Null
Me.boxMormorBenämning = Null
Else ' User chose No.
GoTo Exit_cboAction_Click:
End If
'Msg = Mer variabler och trunkerad text, på två rader:
Msg = "Vill du koppla kostnad [" & Me.boxKostnadID & "] " & Left(Me.boxKommentar, 30) & (Chr(13) & Chr(10)) & " till arbetsorder [" & Forms!frmArbete.cboArbetsorderID & "] " & Left(Forms!frmArbete.boxNotering, 30) & " ?"
Dlookup
msdn DLookup Function VBA
Allen Brown Elookup
'Slå upp variabler
stOrgMorNr = DLookup("[OrgNr]", "tblMaskin", "[MaskinID]= " & OrgMorID & "")
'Slå upp benämningar
boxMor = DLookup("[Benämning]", "tblMaskin", "[MaskinID]= " & OrgMorID & "")
'Testa värde
If Not IsNull(DLookup("[MaskinID]", "tblMaskin", "[OrgMorID]= " & cboMaskinID.Value & "")) Then
'Testa värde innan formulär öppnas
If Not IsNull(DLookup("ReservdelID", "tblKostnad", "ReservdelID= " & Me.ReservdelID & "")) Then
stDocName = "frmKostnad"
stLinkCriteria = "[tblKostnad.ReservdelID]=" & Me![ReservdelID]
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
MsgBox "Det finns inga kostnader registrerade på denna reservdel"
End If
Insert into
'Create new record
DoCmd.RunSQL "Insert into tblKostnad( ArbetsorderID, LeverantörID, ReservdelID ) " & _
"values ( '" & Me.ArbetsorderID & "', '" & Me.cboLeverantörID & "', '" & Me.cboReservdelID & "')"
'Filter to current Leverantör
Me.Filter = "tblLeverantör.LeverantörID = " & Me.box1LeverantörID
Me.FilterOn = True
'Set add property to True (for now)
Me.AllowAdditions = True
'Create new record
DoCmd.RunSQL "Insert into tblPerson( RelationTyp, LeverantörID ) " & _
"values ( '" & Me.RelationTyp & "', '" & Me.box1LeverantörID & "')"
'Refresh the form data
Me.Requery
'Go to last record
DoCmd.GoToRecord acDataForm, "frmLeverantörPerson", acLast
RecordSource
msdn RecordSourse VBA reference
Globala & Publika variabler
Blueclavdb.com Global Variables Access Visual Basic
access-programmers.co.uk forumtråd
VBA-vy, Modul-klassen, Modul1:
Option Compare Database
Option Explicit
'Global
Global stRecordName As String
Global stRecordValue As String
'Public
Public stRecordName As String
Public stRecordValue As String
Constants
Const C_MyCompanyID As Long = 71 'LeverantörID of the users company
'Empty line, to make above underscore visible.
stSQL = "(((tblLeverantör.LeverantörID)=" & C_MyCompanyID & ") AND ((tblArbetsorder.Status)<>'Slutförd'))" & _
"OR (((tblLeverantör.LeverantörID)=" & C_MyCompanyID & ") AND ((tblArbetsorder.Slutdatum) Is Null))"
stLinkCriteria = stSQL
DoCmd.OpenForm stDocName, , , stLinkCriteria
Forms!frmArbeteDetalj.OrderBy = "tblBeskrivning.BeskrivningID DESC"
Forms!frmArbeteDetalj.OrderByOn = True
OrderBy
'Sort ascending (standard)
Me.OrderBy = "tblArbetsorder.ArbetsorderID"
Me.OrderByOn = True
'Sort descending
Me.OrderBy = "tblBeskrivning.BeskrivningID DESC"
Me.OrderByOn = True
SetFocus
'Focus on field
Me.cboReservdelID.SetFocus
RowSource
'Enklare utförande mellan två relaterade tabeller
cboKategori2.RowSource = "SELECT DISTINCT tblReservdel.Kategori2 " & _
"FROM tblReservdel " & _
"WHERE tblReservdel.Kategori1 = '" & cboKategori1.Value & "' " & _
"ORDER BY tblReservdel.Kategori2;"
'Lite knepigare där relationen går via en mellantabell
'Ge radkälla för cboKoppladeReservdelar
cboKoppladeReservdelar.RowSource = "SELECT tblObjektdel.ReservdelID, tblReservdel.Benämning " & _
"FROM tblReservdel INNER JOIN tblObjektdel ON tblReservdel.ReservdelID = tblObjektdel.ReservdelID " & _
"WHERE tblObjektdel.ObjektID = " & Me.ObjektID & " " & _
"ORDER BY tblObjektdel.ReservdelID;"
Nästlade Select-satser
FindRecord
blueclaw-db.com exempel
msdn FindRecord method
DoCmd.FindRecord stItemValue, acEntire, False, acSearchAll, False, acAll, True
DoCmd.FindRecord stItemValue, acEntire, False, acSearchAll, True, acAll, True