Okay i would like to be able to update part attributes table from a form. The Part_ID in table (primary key) is listed in combo box in form (prtnum_cbo) this carries a list of attributes that can be loaded into form, from the table SawPartNumber. I found code that works to Add a new record to table below. But I can not find anything on how to update or edit the record in table linked to Part_ID / prtnum_cbo. Using same logic as add new i can edit.. but only the 1st record in table updates
Private Sub svprt_cmd_Click()
On Error GoTo Error_Handler
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("Select * from SawPartNumber")
rec.AddNew
rec("Part_ID") = Me.prtnum_cbo
rec("Rev") = Me.rev_txt
rec("Tool Type") = Me.tool_cbo
rec("Tool Diameter") = Me.TDia_txt
rec("Wing count") = Me.tip_cnt_txt
rec("Saw Style") = Me.styl_cbo
rec("Kerf") = Me.kerf_txt
rec("Tip style") = Me.tips_cbo
rec("Tip grade") = Me.tipg_txt
rec("Hook") = Me.hook_txt
rec("OD cl") = Me.odcl_txt
rec("Radial") = Me.radin_txt
rec("Back") = Me.backin_txt
rec("Drop") = Me.drop_txt
rec("Top Bvl") = Me.tpbvl_txt
rec("Cnr Brk") = Me.cnrbk_txt
rec("K Lnd") = Me.klnd_txt
rec("Tooth Style Count") = Me.tscnt_txt
rec("Special Notes") = Me.prtnts_txt
rec("Tooth style") = Me.toos_txt
rec.Update
Set rec = Nothing
Set db = Nothing
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "Part already exists"
Resume Error_Handler_Exit
End Sub
Related
I have a simple SelectRecord/PrintSelected macro button to print the current record open on the form. The current record has a numeric textbox on the form named [Aantal], if [Aantal] has value 5, I want the print button to print the current record and the next 4 records after that, so 5 total.
I thought maybe something like this in the print VBA code.
Dim db As Database 'Current database.
Dim lng As Long 'Loop controller.
Dim rs As DAO.Recordset 'Table to append to.
Const conMaxRecords As Long = 20 'Number of records you want.
Set db = DBEngine(0)(0)
Set rs = db.OpenRecordset("Aantal")
With rs
For lng = 1 To conMaxRecords
.AddNew
!CountID = lng
.Update
Next
End With
rs.Close
Set rs = Nothing
Set db = Nothing
MakeData = "Records created."
For anyone that needs it, if your record has a column containing an amount. Let's say 5.
And you are standing on the first record, then this will print that first record and the 4 records after that, so total 5.
This is usefull if you have multiple records created after each other as a group, so they can be printed as a group instead of printing all records or doing it one by one.
Change: AantalForm to your textbox on the form containing the amount.
Private Sub PrintFrm_Click()
On Error GoTo 0
Dim t1 As Integer
Dim t2 As Integer
Dim j As Long
Dim frm As Form
Dim pgn As Integer
pgn = Me.CurrentRecord
t1 = Nz(Me.AantalForm, 1)
If t1 > 1 Then
t2 = pgn + t1 - 1
For j = pgn To t2
DoCmd.PrintOut acSelection
DoCmd.RunCommand acCmdRecordsGoToNext
Next j
Exit Sub
Else
t2 = 0
DoCmd.PrintOut acSelection
Exit Sub
End If
End Sub
Everyone!
I'm working on macros which should select cdrBitmapShape and save it as a separate file.
I've already found out how to search and select such an object, but I've run into a problem of saving it.
I don't get how should I save the chosen image, it is quite unclear from the docs.
As I understand from here I should somehow assign to the Document variable the current selection Item and export it.
Here is the test file
How can I do that?
Sub Findall_bit_map()
' Recorded 03.02.2020
'frmFileConverter.Start
'Dim d As Document
Dim retval As Long
Dim opt As New StructExportOptions
opt.AntiAliasingType = cdrNormalAntiAliasing
opt.ImageType = cdrRGBColorImage
opt.ResolutionX = 600
opt.ResolutionY = 600
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.NumColors = 16
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = Document.ExportBitmap("D:\some.jpg", cdrJPEG)
If Filter.ShowDialog() Then
Filter.Finish
Else
MsgBox "Export canceled"
End If
End If
Next shpCheck
retval = MsgBox("Click OK if you agree.", vbOKCancel, "Easy Message")
'ActivePage.Shapes.FindShapes(Query:="#type='BitmapShape'")
If retval = vbOK Then
MsgBox "You clicked OK.", vbOK, "Affirmative"
End If
End Sub
I don't know were was the bug, but here is the working version.
Sub Findall_bit_map_snip()
Dim retval As Long
Dim doc As Document
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.ColorSensitive = True
pal.NumColors = 300000000
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
Set doc = ActiveDocument
doc.ClearSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = doc.ExportBitmap("D:\some.jpg", cdrJPEG, cdrSelection, , , , 600, 600, cdrNoAntiAliasing, , False, , , , pal)
Filter.Finish
End If
Next shpCheck
End Sub
I need to check if I have enough quantity of a specific product. How do I make it so the quantity that it checks is the one of the product in a textbox(txtIdProd).
This is my code:
Private Sub Cantidad_LostFocus()
Set myDatabase = CurrentDb()
Set myRs = myDatabase.OpenRecordset("TblProductos", dbOpenDynaset)
Dim cant As Integer
cant = txtCantidad
myRs.FindFirst "IDProducto=" & Me.txtIdProd
If myRs.NoMatch = False Then
If cant > myRs("CantidadDisponible") Then
Me.Label27.Visible = True
End If
End If
Exit Sub
Me.Label27.Visible = False
End Sub
The FindFirst code should do exactly what you want. However, probably more efficient to filter the recordset.
Private Sub Cantidad_LostFocus()
Dim cant As Integer
If Not IsNull(Me.txtIDProd) Then
Set myDatabase = CurrentDb()
Set myRs = myDatabase.OpenRecordset("SELECT CantidadDisponible FROM TblProductos WHERE IDProducto=" & Me.txtIdProd, dbOpenDynaset)
cant = rs!CantidadDisponible
End If
Me.Label27.Visible = Me.txtCantidad <= cant
End Sub
Another approach that doesn't use recordset:
Me.Label27.Visible = Me.txtCantidad <= Nz(DLookup("CantidadDisponible", "TblProductos", "IDproducto=" & Nz(Me.txtIDProd,0)), 0)
Note use of <= and assumes txtCantidad will not have 0.
How to initialize a chart with data in MS Access VBA? Eventually I found a suggestion here which with a bit of modification kept intellisense happy and resulted in this code:
Dim objchart As Chart
Dim arrData(3, 1) As Double
arrData(0, 0) = 1
arrData(1, 0) = 1
arrData(2, 0) = 1
arrData(3, 0) = 1
arrData(0, 1) = 1
arrData(1, 1) = 1
arrData(2, 1) = 1
arrData(3, 1) = 1
Set objchart = Me.Chart1
With objchart
.ChartTitle = "test"
.ChartType = acChartLine
.ChartValues = arrData
End With
But this throws
Compile error: Type mismatch
on the line
.ChartValues = arrData
I have tried it as "row-first" (arrData(1, 3)) and also just passing in a single array (arrData(3)). These both result in the same type mismatch error. While the intellisense is telling me that Chart1 exists, and that .ChartValues is a valid field, it doesn't tell me what kind of object it is expecting. I have googled extensively on this and come up empty. The best references I could find for Access VBA were Building VBA Apps and this but neither go into detail on Charts or ChartObjects.
Obviously I'd like to get past this type mismatch error. Even better would be if someone can give me some general advice on how to go about this when the closest thing to a language reference is silent on the part of the language you need.
This is one way to do it. First, create a new table and add some data:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rec As Recordset
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.CreateTableDef("tbl")
With tbl
.Fields.Append .CreateField("first", dbInteger)
.Fields.Append .CreateField("second", dbInteger)
End With
db.TableDefs.Append tbl
db.TableDefs.Refresh
Set rec = db.OpenRecordset("tbl")
rec.AddNew
rec("first").Value = 0
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 1
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 2
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 3
rec("second").Value = 2
rec.Update
Set rec = Nothing
Set db = Nothing
End Sub
Second, graph that data by referencing the new table:
Private Sub command0_click()
Dim objchart As Chart
Set objchart = Me.Chart1
With objchart
.ChartTitle = "tbl: second ~ first"
.RowSource = "tbl"
.ChartAxis = "first"
.ChartValues = "second"
End With
End Sub
I want to call an ABAP function from an Excel VBA Macro.
Is there any method I can follow to achieve this.
Please help me regarding this.
Dim sapConn As Object 'Declare connection object
Set sapConn = CreateObject("SAP.Functions") 'Create ActiveX object
sapConn.Connection.user = "user" 'Specify user
sapConn.Connection.Password = "" 'Then password
sapConn.Connection.client = "001" 'Client
sapConn.Connection.ApplicationServer = "server" 'Target server address
sapConn.Connection.Language = "PT" 'Language code
'Finally, try to logon to the specified system and check if the connection established
If sapConn.Connection.Logon(0, True) <> True Then
MsgBox "Cannot Log on to SAP" 'Issue message if cannot logon
Else
MsgBox "Logged on to SAP!"
End If
Dim rfcAcctDocCheck As Object
Dim oAcctHeader As Object
Dim otAcctAR, otAcctGL, otAcctAP, otAcctAMT, otReturn As Object
Set rfcAcctDocCheck = sapConn.Add("BAPI_ACC_DOCUMENT_CHECK")
Set oAcctHeader = rfcAcctDocCheck.Exports("DOCUMENTHEADER")
Set otAcctGL = rfcAcctDocCheck.Tables("ACCOUNTGL")
Set otAcctAR = rfcAcctDocCheck.Tables("ACCOUNTRECEIVABLE")
Set otAcctAP = rfcAcctDocCheck.Tables("ACCOUNTPAYABLE")
Set otAcctAMT = rfcAcctDocCheck.Tables("CURRENCYAMOUNT")
Set otReturn = rfcAcctDocCheck.Tables("RETURN")
Dim qtLegs As Integer
Dim dt, comp, tpDoc, docRef, tpAcct, acct, customer, vendor, _
curr, val, spLedger, ccenter, order As String
Dim curLine As Integer
For lin = 1 To UBound(reg)
id = Format(tbPost.Cells(reg(lin).lin_ini, K_COL_ID), "0000000000")
dt = getDate(tbPost.Cells(reg(lin).lin_ini, K_COL_DT))
comp = getCompanyCode(tbPost.Cells(reg(lin).lin_ini, K_COL_EMPR))
tpDoc = getDocumentType(tbPost.Cells(reg(lin).lin_ini, K_COL_TP_DOC))
docRef = tbPost.Cells(reg(lin).lin_ini, K_COL_DOC_REF)
otAcctGL.freeTable
otAcctAR.freeTable
otAcctAP.freeTable
otAcctAMT.freeTable
oAcctHeader("USERNAME") = sapConn.Connection.user
oAcctHeader("HEADER_TXT") = "Lancado via Excel"
oAcctHeader("COMP_CODE") = comp
oAcctHeader("DOC_DATE") = dt
oAcctHeader("PSTNG_DATE") = dt
oAcctHeader("DOC_TYPE") = tpDoc
oAcctHeader("REF_DOC_NO") = docRef
otAcctAMT.Rows.Add
otAcctAMT(otAcctAMT.Rows.Count, "ITEMNO_ACC") = Format(leg, "0000000000")
otAcctAMT(otAcctAMT.Rows.Count, "CURRENCY") = curr
otAcctAMT(otAcctAMT.Rows.Count, "AMT_BASE") = val
Next
If rfcAcctDocCheck.Call = False Then
MsgBox rfcAcctDocCheck.Exception
End If