Dobrý večer,
Potřebuji namnožit potřebné množství cenovek v sestavě podle pole [Mnozstvi] v tabulce [tblRozpisNakupu] a filtrované polem [IdNakupu].
Mám formulář [frmNakupy], v něm eviduji fakturační údaje a podformulář [frmRozpisNakupu], kde eviduji nakoupené zboží, které se ukládá do [tblRozpisNakupu]. Táto tabulka má pole [Id], [IdNakupu], [NazevZbozi], [KodPLU], [Cena] a [Mnozstvi].
Na hlavním formuláři chci mít tlačítko [cmdTiskCenovek], po jehož stisku by se každý řádek namnožil podle množství cyklem For 1 To [Mnozstvi] a uložil do připravené prázdné tabulky [tblTMPCenovky].
Následně už klasicky: DoCmd.OpenReport "tiskCenovek", acViewPreview, , , acWindowNormal nebo acViewNormal.
Trochu už toho sice o VBA vím, ale „ RecordSet“ mi moc ještě nejde. Nějak mi nejde pochopit, kde se v něm co skrývá, kde bych měl vložit ten cyklus a kdy vložit Insert.
Děkuji za odpověď.
Jak namnožit potřebné množství cenovek v sestavě
Moderátor: Mods_senior
Re: Jak namnožit potřebné množství cenovek v sestavě
Jelikož nikdo neodpověděl, tak jsem zkoušel sám, až něco začalo fungovat.
Neurazím se a ba naopak uvítám odbornou opravu
Neurazím se a ba naopak uvítám odbornou opravu
Kód: Vybrat vše
Private Sub cmdTiskCenovek_Click()
Dim db As DAO.Database
Dim obj As AccessObject
Dim rstCenovky As DAO.Recordset
Dim strSQL As String
Dim myCreateSQL As String
Dim myInsertSQL As String
Dim intPocetA As Integer
Dim intPocetZ As Integer
Dim varEANKod As Variant
Dim varCenaMOC As Variant
Dim varNazev As Variant
' Načíst všechny tabulky v databázi
For Each obj In Application.CurrentData.AllTables
' Když pomocná tabulka existuje, pokračujeme v kontrole
If obj.Name = "tblTMP_ProTiskCenovek" Then
' je-li pomocná tabulka otevřena
If obj.IsLoaded Then
'...zavřeme ji
DoCmd.Close acTable, "tblTMP_ProTiskCenovek", acSaveNo
End If
'Nyní pomocnou tabulku odstraníme.
DoCmd.DeleteObject acTable, "tblTMP_ProTiskCenovek"
End If
Next obj
' Když tabulka není, tak ji vytvoříme, včetně potřebných polí.
myCreateSQL = "CREATE TABLE tblTMP_ProTiskCenovek"
myCreateSQL = myCreateSQL & " ([KodEAN] Char,"
myCreateSQL = myCreateSQL & " [CenaMOC]Char,"
myCreateSQL = myCreateSQL & " [Nazev]Char)"
DoCmd.RunSQL myCreateSQL
' vytvoříme potřebný SQL dotaz pro nachystaní potřebných záznamů
strSQL = "SELECT ZboziIdProduktu.NazevProduktu AS Nazev, SkladNakupyRozpisy.Mnozstvi AS Mnozstvi, ZboziCenyProduktu.KoncovaCenaMOC AS Cena, ZboziIdProduktu.VlastniKodProduktu AS EanKod"
strSQL = strSQL & " FROM (ZboziIdProduktu INNER JOIN SkladNakupyRozpisy ON ZboziIdProduktu.Id_Produktu = SkladNakupyRozpisy.Produkt)"
strSQL = strSQL & " INNER JOIN ZboziCenyProduktu ON ZboziIdProduktu.Id_Produktu = ZboziCenyProduktu.Id_ProduktuProCeny"
strSQL = strSQL & " WHERE (((SkladNakupyRozpisy.Id_Nakupu)= " & Id_Nakupu & "))"
Set db = CurrentDb
' Vytvoříme sadu záznamů, které budeme tisknout
Set rstCenovky = db.OpenRecordset(strSQL)
If rstCenovky.EOF Then Exit Sub
' Nastavíme na první záznam
rstCenovky.MoveFirst
Do Until rstCenovky.EOF
' Po jednom vkládáme do pomocné tabulky
intPocetZ = rstCenovky.Fields("Mnozstvi")
' Každý záznam zopakujeme podle počtu položek
For intPocetA = 1 To intPocetZ
' Nachystaní cenovky (řádku v tabulce)
varEANKod = rstCenovky.Fields("EanKod")
varCenaMOC = rstCenovky.Fields("Cena")
varNazev = rstCenovky.Fields("Nazev")
' Vytvoření SQL pro vložení nového řádku do tabulky
myInsertSQL = "INSERT INTO tblTMP_ProTiskCenovek "
myInsertSQL = myInsertSQL & "( KodEAN, CenaMOC, Nazev) "
myInsertSQL = myInsertSQL & " VALUES ( '" & varEANKod & "', '" & varCenaMOC & "', '" & varNazev & "')"
' Vypnutí upozorňující hlášky na přidáni nového záznamu (neoznámí ale žádnou chybu)
DoCmd.SetWarnings False
' Vložení nového řádku do tabulky
DoCmd.RunSQL myInsertSQL
' Znovu zapnout chybové hlášky
DoCmd.SetWarnings True
Next
' Přejdeme na další položku a opakujeme násobeni cenovek dalšího zboží
rstCenovky.MoveNext
Loop
' Zrušíme sadu záznamů
Set rstCenovky = Nothing
Set db = Nothing
' Spustíme připravenou sestavu na datech pomocné tabulky v náhledovém zobrazeni
DoCmd.OpenReport "sesCenovkyRayFilm0527", acViewPreview, , , acWindowNormal
End Sub-
- Podobná témata
- Odpovědi
- Zobrazení
- Poslední příspěvek
