在特定位置打印标签

时间:2015-06-11 18:45:12

标签: vba ms-access access-vba ms-access-2007 ms-access-2010

我有11英寸X 8.5英寸纸张来打印标签。该纸分为两列,即每列4.25的宽度,每列含有11个标签。

因此,每个标签的大小为1 inch X 4.25 inch

现在我的问题是:我在MS Access 2010中使用Northwind DB,考虑到表dbo_Products,我想打印产品ID 产品名称每个标签。

我可以加入标签报告,但我无法获得输出。

如前所述该工作表包含两列,如果用户想要在特定标签位置打印标签,则应该能够在其上打印。

(例如,用户希望在位置5 上打印产品ID:10 ,相应的产品信息必须打印在位于第5位置的标签上page。(页面上标签的位置如下所示)

1     |     2 

3     |     4

5     |     6

7     |     8

...... till 22 

如果有人可以通过显示表单之间的连接标签并在特定标签位置打印来帮助我解决这个问题,那就太棒了。

谢谢

1 个答案:

答案 0 :(得分:1)

Start with the instructions found at http://www.techrepublic.com/blog/how-do-i/how-do-i-start-an-access-label-report-with-any-label-on-the-sheet/

Next I modified that to have three textboxes instead of one. They are named 'txtStart', 'txtEnd', 'txtLabelPos'. Use the code below for that form.

Note the 'WHERE' clause in the SQL... change the tables / field names to suit your own needs.

Option Compare Database
Option Explicit


Private Sub cmdCancel_Click()
    'Reset and take no further action.
    Me!txtStart.Value = 1
End Sub



Private Sub cmdPrint_Click()
'Pass table with label data, position for first label, and label report.

Dim bytPosition As Variant
Dim bytCounter As Byte
Dim rst As New ADODB.Recordset

If IsNull(Me.txtStart) Or Me.txtStart = "" Then
    MsgBox "You must enter a starting range for the data.", vbOKOnly + vbCritical, "Missing Start Range"
    Exit Sub
End If

If IsNull(Me.txtEnd) Or Me.txtEnd = "" Then
    MsgBox "You must enter an ending range for the data.", vbOKOnly + vbCritical, "Missing End Range"
    Exit Sub
End If

If IsNull(Me.txtLabelPos) Or Me.txtLabelPos = "" Or Not IsNumeric(Me.txtLabelPos) Then
    MsgBox "You must enter the starting label position to print on.", vbOKOnly + vbCritical, "Missing Label Position"
    Exit Sub
End If

Set rst.ActiveConnection = CurrentProject.Connection
rst.Open "SELECT * FROM tblCustomerLabels" _
        , , adOpenDynamic, adLockOptimistic

'Delete previous label data.
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblCustomerLabels"

'Add one empty record for each missing label.
bytPosition = Nz(Me!txtLabelPos.Value, 0)

For bytCounter = 2 To bytPosition
    rst.AddNew
    rst.Update
Next

'Update label data.
Dim strSQL  As String
strSQL = "INSERT INTO tblCustomerLabels ( Company, [Last Name], [First Name], Address, City, [State/Province], [ZIP/Postal Code], [Country/Region] ) " & _
            "SELECT Customers.Company, Customers.[Last Name], Customers.[First Name], Customers.Address, Customers.City, Customers.[State/Province], Customers.[ZIP/Postal Code], Customers.[Country/Region] " & _
            "FROM Customers " & _
            "Where [Last Name] >= '" & Me.txtStart & "' AND [Last Name] <= '" & Me.txtEnd & "';"
DoCmd.RunSQL strSQL

'Open label report.
DoCmd.SetWarnings True
DoCmd.OpenReport "rptCustomerLabels", acViewPreview

rst.Close
Set rst = Nothing

Exit Sub

errHandler:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
rst.Close
Set rst = Nothing
DoCmd.SetWarnings True

End Sub