First if this a duplicate (that I can't find) I am sorry.
I have been searching for more then a week for an answer to this.
I have an Access 2003 Database that has a Front End (fe) a Back End (be) and a third db that holds the data. I know this seems weird but its a German built Access DB from way back.
Here is the problem. From the main data entry form there is a print button that calls another form. This second form has two text boxes that have a starting and ending order number fields. The starting number is passed from the main form.
There is a another print button on the second form that when clicked creates and prints a report. The report is where the problem is. If I add ANY vba code to the report, even just making a label visible, the report prints nothing. The printer dialog window appears like it is sending something but nothing is ever printed.
I have tried sending to a PDF but nothing. Now if I go to the report code and comment out the line to that makes the label visible the report prints fine. I have been working with DB's along time and I have never seen anything like this, Hell I have never even heard of anything like this.
Be warned that this code has a lot of German in it.
Option Compare Database
Option Explicit
Private Sub Detailbereich_Format(Cancel As Integer, FormatCount As Integer) 'Detail Area Format
'On Error GoTo Err_Detailbereich_Format
Dim dbDatenbank As Database
Dim dtPPSDaten, dtEinfassung, dtToleranz As Recordset
Dim sql As String
Dim T As Double 'Angepasste Tragstablänge
'Adjusted Bearing Bar rod-length
Dim TA As Double 'Anzahl Tragstäbe
'Number of Bearing Bar rods
Dim TA_Anzahl As String 'Zwischenfeld für Tragstabanzahlberechnung ohne Rundung
'Inter-field for Bearing Bar-number-calculation of curve
Dim FA_Anzahl As String 'Zwischenfeld für Füllstabanzahlberechnung ohne Rundung
'Inter-field for Cross Bar-number-calculation of curve
Dim Komma As Byte 'Zwischenfeld zum Filtern der Dezimalzalen
'Inter-field to filtering the decimal zal en
Dim FA As Double 'Füllstabanzahl
'Cross Bar-number
Dim TEM As Double 'Tragstabendmasche
'Bearing Bar Mesh
Dim FEM As Double 'Füllstabendmasche
'Cross Bar Mesh
Dim ZFEM As Double 'Zusatzwert Füllstabendmasche
'Addition-value Cross Bar Mesh
Dim MEMT As Double 'Mindestendmasche Tragstab (Toleranz)
'Bearing Bar Mesh Tolerance
Dim MEMF As Double 'Mindestendmasche Füllstab (Toleranz)
'Cross Bar Mesh Tolerance
Dim Rand1_2 As Double 'Technologischer Abzug Rand1+2 (Toleranz)
'Technological departure edge
Dim Rand3_4 As Double 'Technologischer Abzug Rand3+4 (Toleranz)
'Technological departure edge
Dim Einfassungsdicke As Single '(aus Tabelle: Einfassung)
'Banding Thickness
Dim Einfassungsmaterial As String * 35 '(aus Tabelle: Einfassung)
'Banding Material
Dim Toleranz_Füllstab As Single '(aus Tabelle: Toleranz)
'Cross Bar Tolerance
Dim Toleranz_Tragstab As Single '(aus Tabelle: Toleranz)
'Bearing Bar Tolerance
Dim ProdAuftrag As Long '(aus Tabelle: PPS_Daten_IN)
Dim PositionsNr As String * 3 'Zwischenfeld zum auffüllen der PositionsNr mit Nullen
'Position Number with zeros
Dim Auffüllen As Long 'Zwischenfeld
Dim Barcode_ProdAuftrag As String * 9 'Zwischenfeld
Dim Artikeltyp As Byte 'Zwischenfeld
Dim Durchlauf As Byte 'Zwischenfeld
Dim Inch As Single
Dim Feet As Single
Feet = 10.764
Inch = 25.4
ZFEM = 0
Komma = 0
Durchlauf = 1
'Einfassungsbereich sichtbar machen, evtl. durch Mattenfertigung ausgeblendet
' Border-area visible does, evtl. through mat-production faded out
[Report_Fertigungszettel]![Jahreszahl].Visible = True
[Report_Fertigungszettel]![AuftragsNr].Visible = True
[Report_Fertigungszettel]![Kunde].Visible = True
[Report_Fertigungszettel]![txtEinfassung_Einfassung].Visible = True
[Report_Fertigungszettel]![Position].Visible = True
[Report_Fertigungszettel]![Rostbezeichnung].Visible = True
[Report_Fertigungszettel]![Bestellmenge].Visible = True
'********************************************************************
'Unterschiedliche Einblendung zwischen SP- und P-Rosten
[Report_Fertigungszettel]![lbl_ef_lob1].Visible = True
[Report_Fertigungszettel]![lbl_ef_lob2].Visible = True
[Report_Fertigungszettel]![lbl_ef_lob3].Visible = True
[Report_Fertigungszettel]![Einfassungslänge].Visible = True
[Report_Fertigungszettel]![EinfassungslängeTS].Visible = True
[Report_Fertigungszettel]![EinfassungslängeFS].Visible = True
[Report_Fertigungszettel]![Einfassungslänge_Inch].Visible = True
[Report_Fertigungszettel]![EinfassungslängeTS_Inch].Visible = True
[Report_Fertigungszettel]![EinfassungslängeFS_Inch].Visible = True
[Report_Fertigungszettel]![MaterialbezeichnungTS].Visible = True
[Report_Fertigungszettel]![MaterialbezeichnungEF2].Visible = True
[Report_Fertigungszettel]![lbl_ef_quantity1].Visible = True
[Report_Fertigungszettel]![lbl_ef_quantity2].Visible = True
[Report_Fertigungszettel]![lbl_ef_quantity3].Visible = True
[Report_Fertigungszettel]![Einfassungsanzahl].Visible = True
[Report_Fertigungszettel]![EinfassungsanzahlTS].Visible = True
[Report_Fertigungszettel]![EinfassungsanzahlFS].Visible = True
'********************************************************************
Set dbDatenbank = DBEngine.Workspaces(0).Databases(0)
'Technologische Werte aus Tabelle Toleranz übernehmen
' Update Tolerance Information
sql = "SELECT * FROM Toleranz WHERE Toleranz = " & Toleranz
Set dtToleranz = dbDatenbank.OpenRecordset(sql)
MEMT = dtToleranz![Tol_Tragstab_Min_Masche] 'Bearing Bar Mesh
MEMF = dtToleranz![Tol_Füllstab_Min_Masche] 'Cross Bar Mesh
Rand1_2 = dtToleranz![Tol_Rand1+2] 'Banding Thickness for sides 1 & 2
Rand3_4 = dtToleranz![Tol_Rand3+4] 'Banding Thinckness for sides 3 & 4
Toleranz_Füllstab = dtToleranz![Tol_Füllstab] 'Cross Bar
Toleranz_Tragstab = dtToleranz![Tol_Tragstab] 'Bearing Bar
dtToleranz.Close
'Einfassungswerte aus Tabelle Einfassung übernehmen
' Update Banding Information
sql = "SELECT * FROM Einfassung WHERE Einfassung = " & Einfassung
Set dtEinfassung = dbDatenbank.OpenRecordset(sql)
Einfassungsdicke = dtEinfassung![Einf_Dicke] '
Einfassungsmaterial = dtEinfassung![Einf_Materialbezeichnung]
txtEinfassung_Einfassung.Value = dtEinfassung![Einf_Bezeichnung]
txtFüllstab_Einfassung = dtEinfassung![Einf_Bezeichnung]
txtTragstab_Einfassung = dtEinfassung![Einf_Bezeichnung]
If Einfassungsdicke = 0 Then
txt_hide_banding.Visible = True
txt_hide_banding = "NO BANDING"
End If
dtEinfassung.Close
'Unterscheidung Artikeltyp/Rosttyp
' Case statement based on the part type, keyed off of the first digit of the machine part number
Artikeltyp = Left(Rosttyp, 1)
Select Case Artikeltyp
Case "1"
lblPW1.Visible = False
lblPW2.Visible = True
lblPW3.Visible = True
'Berechnung P-Rost
' Calc BB MFG Length
Tragstablänge = Tragstab - Einfassungsdicke - Einfassungsdicke - Toleranz_Tragstab
Tragstablänge_Inch = Tragstablänge / Inch
' Calc CB MFG Length
Füllstablänge = Füllstab - Toleranz_Füllstab
Füllstablänge_Inch = Füllstablänge / Inch
' MaterialbezeichnungEF1 = Einfassungsmaterial
MaterialbezeichnungEF2 = Einfassungsmaterial
' Calc CB Banding Length
EinfassungslängeFS = Füllstab - Rand3_4
EinfassungslängeFS_Inch = EinfassungslängeFS / Inch
' Calc BB Banding Length
EinfassungslängeTS = Tragstab - Rand1_2
EinfassungslängeTS_Inch = EinfassungslängeTS / Inch
' Calc Total Banding Qty (Qty * 2)
EinfassungsanzahlTS = Bestellmenge * 2
EinfassungsanzahlFS = Bestellmenge * 2
'******************************************************************
'FIX
' Add Comments for LARGE BB pieces (over 1800mm)
' If (Tragstablänge > 1800) Or (Füllstablänge > 1800) Then
' lblcommentsBand = "OVER 1800mm, ENTER BANDING MANUALLY in 2 PIECES. " & lblcommentsBand
' Else
' lblcommentsBand = Comments
' End If
'*******************************************************************
TA_Anzahl = Füllstab / Tragstabteiler
Komma = InStr(1, TA_Anzahl, ".", vbTextCompare)
If Komma <> 0 Then
TA = CInt(Left(TA_Anzahl, (Komma - 1)))
Else
TA = CInt(TA_Anzahl)
End If
Komma = 0
FA_Anzahl = Tragstab / Füllstabteiler
Komma = InStr(1, FA_Anzahl, ".", vbTextCompare)
If Komma <> 0 Then
FA = CInt(Left(FA_Anzahl, (Komma - 1)))
Else
FA = CInt(FA_Anzahl)
End If
TEM = (Tragstablänge - ((FA - 1) * Füllstabteiler)) / 2
If TEM < MEMT Then
FA = FA - 1
TEM = (Tragstablänge - ((FA - 1) * Füllstabteiler)) / 2
If TEM < MEMT Then
FA = FA - 1
TEM = (Tragstablänge - ((FA - 1) * Füllstabteiler)) / 2
End If
End If
If TEM < ((Füllstabteiler / 2) + (Füllstabteiler * 0.05)) Then
FA = FA - 1
TEM = (Tragstablänge - ((FA - 1) * Füllstabteiler)) / 2
End If
FEM = (Füllstablänge - ((TA - 1) * Tragstabteiler)) / 2
If FEM < MEMF Then
TA = TA - 1
FEM = (Füllstablänge - ((TA - 1) * Tragstabteiler)) / 2
If FEM < MEMF Then
TA = TA - 1
FEM = (Füllstablänge - ((TA - 1) * Tragstabteiler)) / 2
End If
End If
If FEM < ((Tragstabteiler / 2) + (Tragstabteiler * 0.05)) Then
TA = TA - 1
FEM = (Füllstablänge - ((TA - 1) * Tragstabteiler)) / 2
End If
Füllstabendmasche = Format(FEM, "###0.00")
Füllstabendmasche_Inch = Füllstabendmasche / Inch
füllstabendmasche_1 = Format(FEM, "###0.00")
Füllstabendmasche_1_Inch = füllstabendmasche_1 / Inch
'********************************************************************
'Unterschiedliche Einblendung zwischen SP- und P-Rosten
[Report_Fertigungszettel]![lbl_ef_lob1].Visible = False
[Report_Fertigungszettel]![Einfassungslänge].Visible = False
[Report_Fertigungszettel]![MaterialbezeichnungTS].Visible = False
[Report_Fertigungszettel]![lbl_ef_quantity1].Visible = False
[Report_Fertigungszettel]![Einfassungsanzahl].Visible = False
'Ausblendung Stückzahlen bei T-Einfassung - Wunsch von Hr. Johann wegen Verwirrung bei Produktion Ohio
If Toleranz = 1 Then
[Report_Fertigungszettel]![EinfassungsanzahlTS].Visible = False
[Report_Fertigungszettel]![EinfassungsanzahlFS].Visible = False
[Report_Fertigungszettel]![lbl_ef_quantity2].Visible = False
[Report_Fertigungszettel]![lbl_ef_quantity3].Visible = False
End If
'********************************************************************
Case 2
lblPW1.Visible = True
lblPW2.Visible = False
lblPW3.Visible = False
'Entscheidungskriterium für Mattenfertigung
'Adjournment-criterion for mat-production
If Einfassungsdicke = 0 Then
T = Tragstab - Rand3_4
Else
T = Tragstab - (Tragstabdicke * 2) - Rand3_4
End If
'Berechnung SP-Rost
'Calculation SP-Rost
'TA-Anzahl = ((CrossBar - BearingBarThickness) / BearingBarPitch
TA_Anzahl = ((Füllstab - Tragstabdicke) / Tragstabteiler)
Komma = InStr(1, TA_Anzahl, ".", vbTextCompare)
If Komma <> 0 Then
'NumberOfBearingBars = CInt(Left(TA_Anzahl, (Komma - 1))) + 2
TA = CInt(Left(TA_Anzahl, (Komma - 1))) + 2
Else
'NumberOfBearingBars = CInt(TA_Anzahl) + 2
TA = CInt(TA_Anzahl) + 2
End If
'CrossBarNumber = MFG BearingBar Length \ CrossBarPitch
FA = T \ Füllstabteiler
'CrossBarNumber = (CrossBarNumber \ 2) * 2
FA = (FA \ 2) * 2
'BearingBarMesh = (MFGBearingBarLength - (CrossBarNumber-1)*CrossBarPitch)/2
TEM = (T - (FA - 1) * Füllstabteiler) / 2
'If BearingBarMesh >= (CrossBarPitch + BearingBarMeshTolerance) Then
If TEM >= (Füllstabteiler + MEMT) Then
'CrossBarNumber = CrosbarNumber + 2
FA = FA + 2
'BearingBarMesh = (MFBearingBarLength - (CrossBarNumber - 1) * CrossBarPitch) / 2
TEM = (T - (FA - 1) * Füllstabteiler) / 2
End If
'If BearingBarMesh < BearingBarMeshTolerance then
If TEM < MEMT Then
'CrossBarNumber = CrossBarNumber - 2
FA = FA - 2
'BearingBarMesh = (MFGBearingBarLength - (CrossBarNumber - 1) * CrossBarPitch) /2
TEM = (T - (FA - 1) * Füllstabteiler) / 2
End If
Select Case Tragstabteiler 'BearingBarPitch
Case 30.15
'CrossBarMesh = CrossBarLength - (NumberofBearingBars - 2) * BearingBarPitch - Side3&4 banding thickness - (2 * Bearing Bar Thickness)
FEM = Füllstab - (TA - 2) * Tragstabteiler - Rand3_4 - (2 * Tragstabdicke)
'If CrossBarMesh < 16.6 AND CrosbarMesh > = 1 then
If FEM < 16.6 And FEM >= 1 Then
'CrossBarMesh = CrosbarMesh + 15.07
FEM = FEM + 15.07
'CrossBarMesh plus value = 15
ZFEM = 15.07
End If
'If CrossBarMesh < 1 then
If FEM < 1 Then
'CrossBarMesh = CrossBarMesh + 30.15
FEM = FEM + 30.15
'NumberOfBearingBarRods = NumberOfBearingBarRods - 1
TA = TA - 1
End If
Case 30.16
'CrossBarMesh = CrossBarLength - (NumberofBearingBars - 2) * BearingBarPitch - Side3&4 banding thickness - (2 * Bearing Bar Thickness)
FEM = Füllstab - (TA - 2) * Tragstabteiler - Rand3_4 - (2 * Tragstabdicke)
'If CrossBarMesh < 16.6 AND CrosbarMesh > = 1 then
If FEM < 16.6 And FEM >= 1 Then
'CrossBarMesh = CrosbarMesh + 15.07
FEM = FEM + 15.07
'CrossBarMesh plus value = 15
ZFEM = 15.07
End If
'If CrossBarMesh < 1 then
If FEM < 1 Then
'CrossBarMesh = CrossBarMesh + 30.15
FEM = FEM + 30.15
'NumberOfBearingBarRods = NumberOfBearingBarRods - 1
TA = TA - 1
End If
Case Else
'CrossBarMesh = 9999
FEM = 9999
TA = TA - 1
End Select
' Calc CB MFG Length
'CrossBarLength = CrossBar + CrossBarTolerance
Füllstablänge = Füllstab + Toleranz_Füllstab
'CrosBarLength = CrossBarLength / 25.4
Füllstablänge_Inch = Füllstablänge / Inch
' Calc BB MFG Length
'BearingBarLength = (BearingBar - Side3&4BandThickness - (2 * BandingThickness)
Tragstablänge = (Tragstab - Rand3_4 - (2 * Einfassungsdicke))
Tragstablänge_Inch = Tragstablänge / Inch
MaterialbezeichnungEF2 = Einfassungsmaterial
' Calc CB Banding Length
EinfassungslängeFS = Füllstab - Rand3_4
EinfassungslängeFS_Inch = EinfassungslängeFS / Inch
' Calc BB Banding Length
EinfassungslängeTS = Tragstab - Rand1_2
EinfassungslängeTS_Inch = EinfassungslängeTS / Inch
' Calc Total Banding Qty (Qty * 2)
EinfassungsanzahlTS = Bestellmenge * 2
EinfassungsanzahlFS = Bestellmenge * 2
'INCH Anpassung nicht vergessen
Füllstabendmasche = Format(FEM, "###0.00") '& " : " & Format(ZFEM, "###0.00")
füllstabendmasche_1 = Format(FEM, "###0.00") '& " : " & Format(ZFEM, "###0.00")
Füllstabendmasche_Inch = Format(FEM / Inch, "###0.00") & " : " & ZFEM
Füllstabendmasche_1_Inch = Format(FEM / Inch, "###0.00") & " : " & ZFEM
'Bei Mattenfertigung wird Einfassunsbereich nicht angedruckt
If Einfassungsdicke = 0 Then
[Report_Fertigungszettel]![Jahreszahl].Visible = False
[Report_Fertigungszettel]![AuftragsNr].Visible = False
[Report_Fertigungszettel]![Kunde].Visible = False
[Report_Fertigungszettel]![txtEinfassung_Einfassung].Visible = False
[Report_Fertigungszettel]![Position].Visible = False
[Report_Fertigungszettel]![txtTragstab].Visible = False
[Report_Fertigungszettel]![txtFüllstab].Visible = False
[Report_Fertigungszettel]![Rostbezeichnung].Visible = False
[Report_Fertigungszettel]![Bestellmenge].Visible = False
[Report_Fertigungszettel]![Einfassungslänge].Visible = False
[Report_Fertigungszettel]![Einfassungsanzahl].Visible = False
[Report_Fertigungszettel]![MaterialbezeichnungTS].Visible = False
Else
Einfassungslänge = Füllstab
Einfassungslänge_Inch = Einfassungslänge / Inch
Einfassungsanzahl = Bestellmenge * 2
End If
Case Else
FEM = 9999
TEM = 9999
End Select
'********************************************************************
'Berichtsfelder zuweisen - Bereich Füllstab
Füllstabanzahl = FA * Bestellmenge & " / " & FA
'Berichtsfelder zuweisen - Bereich Tragstab
'Report-fields assign - area filling-rod
Tragstabanzahl = TA * Bestellmenge & " / " & TA
Tragstabendmasche = Format(TEM, "###0.00")
Tragstabendmasche_Inch = Tragstabendmasche / Inch
Klinkung = FA
'Zeichnungskästchen anzeigen
'Show Drawing Boxes
If Zeichnung = -1 Then
lblZeichnungBearing = "Review Traveler / DWG"
lblZeichnungCross = "Review Traveler / DWG"
lblZeichnungBand = "Review Traveler / DWG"
Else
lblZeichnungBearing = ""
lblZeichnungCross = ""
lblZeichnungBand = ""
End If
'Barcode links ausfüllen
'Fill Barcode Links
If Len(Position) <> 3 Then
Auffüllen = 3 - Len(Position)
PositionsNr = String(Auffüllen, "0") & Position
End If
'********************************************************************
'Daten Fertigungszettel in Datenbank PPS-Daten.mdb schreiben
'Write the records to the PPS-Daten-IN db
sql = "SELECT * FROM [PPS-Daten-IN] where Projekt = " & AuftragsNr & " and Artikel = """ & Mark & """"
Set dtPPSDaten = dbDatenbank.OpenRecordset(sql)
If dtPPSDaten.RecordCount = 0 Then
' Get the Seq number
Dim db As Database
Dim rs, ros As Recordset
Dim dbSQL, rosSQL As String
Set db = DBEngine.Workspaces(0).Databases(0)
dbSQL = "SELECT SeqNum FROM [SEQNum] where ID = 1"
Set rs = db.OpenRecordset(dbSQL)
rosSQL = "SELECT HöheTS, DickeFS FROM Rostbezeichnung WHERE Rostbezeichnung = """ & Rostbezeichnung & """"
Set ros = db.OpenRecordset(rosSQL)
With rs
.Edit
!SeqNum = !SeqNum + 1
.Update
End With
OpSeqBand.Caption = rs!SeqNum
OpSeqCB.Caption = rs!SeqNum
OpSeqBB.Caption = rs!SeqNum
With dtPPSDaten
.AddNew
!Projekt = AuftragsNr
!Bez_Rost = Rostbezeichnung
!Artikel = Mark
!Arttext1 = rs!SeqNum
!Rost_TS = Tragstab
!Rost_FS = Füllstab
!Stück_S0 = Bestellmenge
!Bez_Komp_1 = Einfassungsmaterial
!Länge_1 = EinfassungslängeTS
!Länge_2 = EinfassungslängeTS
!Länge_3 = EinfassungslängeFS
!Länge_4 = EinfassungslängeFS
!Bez_Komp_5 = MaterialbezeichnungTS
!Länge_TS = Tragstablänge
!Endma_TS = Format(TEM, "###0.00")
!Stück_TS = TA
!Teilung_TS = Tragstabteiler
!Bez_Komp_6 = MaterialbezeichnungFS
!Länge_FS = Füllstablänge
!Endma_FS = Format(FEM, "###0.00")
!Stück_FS = FA
!Teilung_FS = Füllstabteiler
!Eintragsdatum = Forms![Fertigungskopf]![Datum]
!Höhe_TS = ros!HöheTS
!Stärke_FS = ros!DickeFS
ProdAuftrag = !Prodauftr
.Update
End With
dtPPSDaten.Close
rs.Close
Else
' The to take into account the looping issue. When this is the 2nd time through on the same
' Mark #, then get the Machine # for the report
dtPPSDaten.Close
sql = "SELECT Prodauftr, Arttext1 FROM [PPS-Daten-IN] where Projekt = " & AuftragsNr & " and Artikel = """ & Mark & """"
Set dtPPSDaten = dbDatenbank.OpenRecordset(sql)
ProdAuftrag = dtPPSDaten.Prodauftr
OpSeqBand.Caption = dtPPSDaten.Arttext1
OpSeqCB.Caption = dtPPSDaten.Arttext1
OpSeqBB.Caption = dtPPSDaten.Arttext1
dtPPSDaten.Close
End If
'End If
'********************************************************************
'Barcode rechts ausfüllen (nachgelagert wegen Produktionsauftragsnummer aus Tabelle PPS-Daten-IN)
If Len(Trim(ProdAuftrag)) <> 9 Then
Auffüllen = 9 - Len(Trim(ProdAuftrag))
Barcode_ProdAuftrag = String(Auffüllen, "0") & ProdAuftrag
Barcode_PA_Edgebanding = "*" & Barcode_ProdAuftrag & "*"
Barcode_PA_crossbar = "*" & Barcode_ProdAuftrag & "*"
Barcode_PA_Bearingbar = "*" & Barcode_ProdAuftrag & "*"
Else
Barcode_PA_Edgebanding = "*" & Barcode_ProdAuftrag & "*"
Barcode_PA_crossbar = "*" & Barcode_ProdAuftrag & "*"
Barcode_PA_Bearingbar = "*" & Barcode_ProdAuftrag & "*"
End If
'------------------------------------------------------------------
Me.Label444.Visible
Me.Label445.Visible
Exit_Detailbereich_Format:
Exit Sub
Err_Detailbereich_Format:
MsgBox Err.Description
Resume Exit_Detailbereich_Format
End Sub
If you scroll to the very end you will see to lines that make labels 444 and 445 visible. If i comment this lines out, as they are the only ones I added, the report will work correctly.
Oh and it does not matter where the code is placed as the end result is always the same, no output.
Does anyone have any idea as to why this is happening?? I have hit the wall on this one.
Thanks to any suggestions I can get.
