From 197878eb59f08e11af9695f4b0bcf8f87f7abd6e Mon Sep 17 00:00:00 2001 From: Stoyan Zlatev Date: Thu, 27 Apr 2023 12:13:11 +0000 Subject: [PATCH] Upload New File --- Shared/frmFertigungslisten.frm | 7609 ++++++++++++++++++++++++++++++++ 1 file changed, 7609 insertions(+) create mode 100644 Shared/frmFertigungslisten.frm diff --git a/Shared/frmFertigungslisten.frm b/Shared/frmFertigungslisten.frm new file mode 100644 index 00000000..2a3f1800 --- /dev/null +++ b/Shared/frmFertigungslisten.frm @@ -0,0 +1,7609 @@ +VERSION 5.00 +Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX" +Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX" +Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" +Begin VB.Form frmFertigungslisten + Caption = "Listendruck" + ClientHeight = 8085 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 18300 + KeyPreview = -1 'True + LinkTopic = "Form1" + MDIChild = -1 'True + ScaleHeight = 8085 + ScaleWidth = 18300 + Begin VB.Frame Frame5 + Height = 1485 + Left = 15210 + TabIndex = 89 + Top = 2070 + Width = 2925 + Begin VB.CommandButton cmdLotHinzu + Caption = "+" + BeginProperty Font + Name = "MS Sans Serif" + Size = 12 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 300 + Left = 1830 + TabIndex = 94 + ToolTipText = "AuftragNr-Bereich in Liste speichern" + Top = 210 + Width = 435 + End + Begin VB.ComboBox cmbLot + Height = 315 + Left = 120 + TabIndex = 93 + ToolTipText = "Liste der AuftragNr-Bereiche / Lots" + Top = 540 + Width = 2655 + End + Begin VB.TextBox txtAuftragVon + Alignment = 1 'Rechts + Height = 285 + Left = 120 + TabIndex = 92 + ToolTipText = "Erste AuftragNr im Bereich der angezeigt werden soll" + Top = 930 + Width = 1155 + End + Begin VB.TextBox txtAuftragBis + Alignment = 1 'Rechts + Height = 285 + Left = 1590 + TabIndex = 91 + ToolTipText = "letzte AuftragNr im Bereich der angezeigt werden soll" + Top = 930 + Width = 1155 + End + Begin VB.CommandButton cmdLotEntfernen + Caption = "-" + BeginProperty Font + Name = "MS Sans Serif" + Size = 12 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 300 + Left = 2310 + TabIndex = 90 + ToolTipText = "AuftragNr-Bereich aus Liste entfernen" + Top = 210 + Width = 435 + End + Begin VB.Label Label23 + Caption = "Lot / Auftragnr-Bereich" + Height = 345 + Left = 120 + TabIndex = 95 + Top = 300 + Width = 1635 + End + Begin VB.Line Line1 + X1 = 1350 + X2 = 1515 + Y1 = 1065 + Y2 = 1065 + End + End + Begin VB.Frame Frame4 + Height = 1605 + Left = 15210 + TabIndex = 86 + Top = 450 + Width = 2895 + Begin VB.CheckBox chkNur_eRegister + Caption = "Nur eRegister anzeigen" + Height = 315 + Left = 120 + TabIndex = 101 + Top = 300 + Width = 2235 + End + Begin VB.CheckBox chkVersandIstDatumStattSerienNr + Caption = "Versand_ist_Datum statt Seriennummer " + Height = 375 + Left = 120 + TabIndex = 88 + Top = 1020 + Width = 1815 + End + Begin VB.CheckBox chkDebug + Caption = "zeige 'geprüft'" + Height = 345 + Left = 120 + TabIndex = 87 + Top = 630 + Width = 1335 + End + End + Begin VB.CommandButton cmdExcelExport + Caption = "Excel Export" + Height = 375 + Left = 9960 + TabIndex = 85 + Top = 7140 + Width = 1125 + End + Begin VB.Frame Frame1 + Caption = "Listendruck" + Height = 3105 + Left = 0 + TabIndex = 0 + Top = 450 + Width = 15195 + Begin VB.CommandButton cmdLaser + Caption = "Laser" + Height = 375 + Left = 120 + TabIndex = 96 + Top = 2610 + Width = 645 + End + Begin VB.CommandButton cmdSofortauftraege + Caption = "Sofortauftraege" + Height = 375 + Left = 2610 + TabIndex = 74 + ToolTipText = "alle WZ und ME ohne FA-Nr" + Top = 2610 + Width = 1275 + End + Begin VB.CommandButton cmdEinsatz + Caption = "Einsatz" + Height = 375 + Left = 5160 + TabIndex = 72 + ToolTipText = "Messeinsatz montiert" + Top = 2610 + Width = 675 + End + Begin VB.CommandButton cmdDruckNeu + Caption = "Print Grid" + Height = 375 + Left = 13980 + TabIndex = 48 + Top = 2610 + Width = 1035 + End + Begin VB.CommandButton cmdVersandfertig + Caption = "Versandfertig" + Height = 375 + Left = 9090 + TabIndex = 40 + Top = 2610 + Width = 1125 + End + Begin VB.CommandButton cmdPruefen + Caption = "Prüfen" + Height = 375 + Left = 6960 + TabIndex = 30 + Top = 2610 + Width = 765 + End + Begin VB.CommandButton cmdExcel + Caption = "=> Zwischenablage" + Height = 375 + Left = 12330 + TabIndex = 29 + ToolTipText = "kopiert den Tabelleninhalt in die Zwischenablage" + Top = 2610 + Width = 1545 + End + Begin VB.Frame Frame3 + Height = 2355 + Left = 12330 + TabIndex = 23 + Top = 180 + Width = 2685 + Begin VB.CheckBox chkSerNrKnd + Alignment = 1 'Rechts ausgerichtet + Caption = "Knd eigene" + Enabled = 0 'False + Height = 225 + Left = 1470 + TabIndex = 82 + Top = 1800 + Width = 1125 + End + Begin VB.CheckBox chkSerNrSensus + Alignment = 1 'Rechts ausgerichtet + Caption = "SNr: Sensus " + Enabled = 0 'False + Height = 225 + Left = 120 + TabIndex = 81 + Top = 1800 + Width = 1185 + End + Begin VB.CheckBox chkStatistik + Alignment = 1 'Rechts ausgerichtet + Caption = "Statistik auswerten" + Enabled = 0 'False + Height = 195 + Left = 600 + TabIndex = 80 + ToolTipText = "auch fertiggemeldete Positionen anzeigen" + Top = 2070 + Width = 1995 + End + Begin VB.CheckBox chkSonderlayoutFertigung + Alignment = 1 'Rechts ausgerichtet + Caption = "Sonderlayout für Fertigung " + Height = 225 + Left = 390 + TabIndex = 77 + ToolTipText = "bestimmte Voreinstellungen, das Layout und die Auswahl werden für den 'Versuch' optimiert" + Top = 1560 + Width = 2205 + End + Begin VB.CheckBox chkSpaltenbreiteAnpassen + Alignment = 1 'Rechts ausgerichtet + Caption = "Spaltenbreite anpassen" + Height = 195 + Left = 600 + TabIndex = 76 + ToolTipText = "Spaltenbreite automatisch anpassen" + Top = 1320 + Width = 1995 + End + Begin VB.CheckBox chkVersuch + Alignment = 1 'Rechts ausgerichtet + Caption = "Sonderlayout für Versuch" + Height = 225 + Left = 480 + TabIndex = 41 + ToolTipText = "bestimmte Voreinstellungen, das Layout und die Auswahl werden für den 'Versuch' optimiert" + Top = 1050 + Width = 2115 + End + Begin VB.ComboBox cmbAnzahlKopien + Height = 315 + Left = 1890 + Style = 2 'Dropdown-Liste + TabIndex = 26 + Top = 120 + Width = 705 + End + Begin VB.ComboBox cmbSortierung + Height = 315 + Left = 90 + Style = 2 'Dropdown-Liste + TabIndex = 25 + Top = 480 + Width = 2535 + End + Begin VB.CheckBox chkSortierungDesc + Alignment = 1 'Rechts ausgerichtet + Caption = "umgekehrte Sortierung" + Height = 285 + Left = 480 + TabIndex = 24 + Top = 780 + Width = 2115 + End + Begin VB.Label Label5 + Caption = "Kopien" + Height = 225 + Left = 1290 + TabIndex = 28 + Top = 180 + Width = 555 + End + Begin VB.Label Label6 + Caption = "Sortierung" + Height = 255 + Left = 90 + TabIndex = 27 + Top = 270 + Width = 795 + End + End + Begin VB.Frame Frame2 + Caption = "Filter" + Height = 2355 + Left = 120 + TabIndex = 10 + Top = 180 + Width = 12135 + Begin VB.CommandButton cmdVorauswahllLaser + Caption = "Laser" + Height = 225 + Left = 90 + TabIndex = 97 + Top = 2010 + Width = 555 + End + Begin VB.ComboBox cmbFilterBohrbild + Height = 315 + Left = 9870 + TabIndex = 78 + Top = 1800 + Width = 2175 + End + Begin VB.CommandButton cmdAuftragNrClear + Cancel = -1 'True + Caption = "c" + Height = 255 + Left = 6000 + TabIndex = 75 + ToolTipText = "Clear Filter AuftragNr " + Top = 300 + Width = 255 + End + Begin VB.CheckBox chkOhneLager + Alignment = 1 'Rechts ausgerichtet + Caption = "ohne Lager" + Height = 285 + Left = 1830 + TabIndex = 71 + ToolTipText = "Einschränkung: Auftragspositionen mit Kundennumer 1000 ausblenden" + Top = 510 + Width = 1245 + End + Begin VB.CheckBox chkNurMID + Alignment = 1 'Rechts ausgerichtet + Caption = "nur MID" + Height = 285 + Left = 2160 + TabIndex = 70 + ToolTipText = "Einschränkung nach Zusatztext mit ""Zulassungskennzeichen : MID"" " + Top = 210 + Width = 915 + End + Begin VB.CheckBox chkNoMoskauBadger + Caption = "ohne Moskau / Badger" + Height = 405 + Left = 8370 + TabIndex = 69 + ToolTipText = "Es werden nur Aufträge ohne KundenNr 38116 und 38045 angezeigt." + Top = 210 + Width = 1425 + End + Begin VB.ComboBox cmbFilterNennweite + Height = 315 + Left = 10680 + TabIndex = 60 + Top = 360 + Width = 1035 + End + Begin VB.ComboBox cmbFilterTemp + Height = 315 + Left = 10680 + TabIndex = 59 + Top = 720 + Width = 1035 + End + Begin VB.ComboBox cmbFilterDruck + Height = 315 + Left = 10680 + TabIndex = 58 + Top = 1080 + Width = 1035 + End + Begin VB.ComboBox cmbFilterBaulaenge + Height = 315 + Left = 10680 + TabIndex = 57 + Top = 1440 + Width = 1035 + End + Begin VB.ListBox lstAPOrt + Height = 1620 + Left = 450 + MultiSelect = 2 'Erweitert + TabIndex = 55 + Top = 210 + Width = 1215 + End + Begin VB.ComboBox cmbFilterMetrolog + Height = 315 + Left = 4710 + TabIndex = 53 + Text = "Combo1" + ToolTipText = "Es werden nur Auftragspositionen angezeigt, die diese Prüfklasse haben" + Top = 1350 + Width = 1515 + End + Begin VB.CheckBox ChkOhnePlus + Caption = "ohne PLUS" + Height = 195 + Left = 8370 + TabIndex = 52 + ToolTipText = "Nur Zähler ohne Zusatztext 'PLUS' werden angezeigt" + Top = 1200 + Width = 1185 + End + Begin VB.CheckBox chkRest + Caption = "Rest" + Height = 225 + Left = 8370 + TabIndex = 51 + ToolTipText = "Typ Auswahl umkehren" + Top = 1470 + Width = 945 + End + Begin VB.CheckBox chkNurCKD + Caption = "nur CKD" + Height = 195 + Left = 8370 + TabIndex = 50 + ToolTipText = "nur Zählertypen mit 'CKD' in der Bezeichnung werden angezeigt" + Top = 660 + Width = 945 + End + Begin VB.CheckBox chkPlus + Caption = "nur PLUS" + Height = 195 + Left = 8370 + TabIndex = 47 + ToolTipText = "Nur Zähler mit Zusatztext 'PLUS' werden angezeigt" + Top = 930 + Width = 1035 + End + Begin VB.CommandButton cmdInfoTyp + Caption = "?" + Height = 225 + Left = 8040 + TabIndex = 45 + ToolTipText = "zeigt alle ausgewählten Typen übersichtlicher an" + Top = 300 + Width = 285 + End + Begin VB.CommandButton cmdRefreshTyp + Caption = "Refresh" + Height = 225 + Left = 7290 + TabIndex = 44 + Top = 300 + Width = 735 + End + Begin VB.ListBox lstFilterTyp + Height = 1620 + Left = 6660 + MultiSelect = 2 'Erweitert + TabIndex = 42 + Top = 570 + Width = 1665 + End + Begin VB.CommandButton cmdAuftragInfo + Caption = "i" + Enabled = 0 'False + Height = 255 + Left = 6300 + TabIndex = 34 + ToolTipText = "Auftragnr anzeigen" + Top = 300 + Width = 255 + End + Begin VB.ComboBox cmbKurzBez + Height = 315 + Left = 4710 + TabIndex = 16 + Text = "Combo1" + Top = 990 + Width = 1515 + End + Begin VB.TextBox txtFilterAuftrag + Alignment = 1 'Rechts + Height = 285 + Left = 4830 + TabIndex = 12 + ToolTipText = "AuftragNr oder FertigungsauftragNr" + Top = 300 + Width = 1125 + End + Begin VB.TextBox txtFilterKunde + Alignment = 1 'Rechts + Height = 285 + Left = 4830 + TabIndex = 11 + Top = 630 + Width = 1125 + End + Begin MSComCtl2.DTPicker DTPickerBis + Height = 315 + Left = 2160 + TabIndex = 18 + Top = 1440 + Width = 1215 + _ExtentX = 2143 + _ExtentY = 556 + _Version = 393216 + Format = 79757313 + CurrentDate = 39184 + End + Begin MSComCtl2.DTPicker DTPickerVon + Height = 315 + Left = 2160 + TabIndex = 20 + Top = 1050 + Width = 1245 + _ExtentX = 2196 + _ExtentY = 556 + _Version = 393216 + Format = 79757313 + CurrentDate = 39184 + End + Begin VB.Label Label22 + Caption = "Bohrbild:" + Height = 225 + Left = 9000 + TabIndex = 79 + Top = 1920 + Width = 765 + End + Begin VB.Label Label10 + Caption = "Nennweite" + Height = 225 + Left = 9840 + TabIndex = 68 + Top = 390 + Width = 825 + End + Begin VB.Label Label12 + Caption = "Temperatur" + Height = 225 + Left = 9750 + TabIndex = 67 + Top = 720 + Width = 975 + End + Begin VB.Label Label13 + Caption = "PN" + Height = 225 + Left = 10290 + TabIndex = 66 + Top = 1110 + Width = 315 + End + Begin VB.Label Label14 + Caption = "°C" + Height = 255 + Left = 11790 + TabIndex = 65 + Top = 780 + Width = 255 + End + Begin VB.Label Label15 + Caption = "bar" + Height = 255 + Left = 11760 + TabIndex = 64 + Top = 1080 + Width = 255 + End + Begin VB.Label Label16 + Caption = "mm" + Height = 165 + Left = 11760 + TabIndex = 63 + Top = 390 + Width = 285 + End + Begin VB.Label Label11 + Caption = "Baulänge:" + Height = 225 + Left = 9900 + TabIndex = 62 + Top = 1470 + Width = 765 + End + Begin VB.Label Label17 + Caption = "mm" + Height = 255 + Left = 11760 + TabIndex = 61 + Top = 1440 + Width = 255 + End + Begin VB.Label Label20 + Caption = "von" + Height = 165 + Left = 1770 + TabIndex = 56 + Top = 1110 + Width = 315 + End + Begin VB.Label Label19 + Caption = "Metrolog" + Height = 255 + Left = 3990 + TabIndex = 54 + Top = 1440 + Width = 645 + End + Begin VB.Label Label18 + Caption = "Typen:" + Height = 225 + Left = 6720 + TabIndex = 43 + Top = 300 + Width = 1125 + End + Begin VB.Label Label1 + Caption = "Ort" + Height = 285 + Left = 150 + TabIndex = 22 + Top = 300 + Width = 255 + End + Begin VB.Label Label2 + Caption = "bis" + Height = 165 + Left = 1770 + TabIndex = 21 + Top = 1500 + Width = 315 + End + Begin VB.Label Label3 + Caption = "Datum" + Height = 225 + Left = 2160 + TabIndex = 19 + Top = 780 + Width = 585 + End + Begin VB.Label Label9 + Caption = "Kurzbez." + Height = 255 + Left = 4020 + TabIndex = 17 + Top = 1020 + Width = 645 + End + Begin VB.Label Label8 + Caption = "KundenNr" + Height = 225 + Left = 4050 + TabIndex = 14 + Top = 660 + Width = 855 + End + Begin VB.Label Label7 + Caption = "AuftragNr" + Height = 225 + Left = 4050 + TabIndex = 13 + Top = 330 + Width = 825 + End + End + Begin VB.CommandButton cmdRechenwerk + Caption = "Rechenwerk" + Height = 375 + Left = 7860 + TabIndex = 5 + Top = 2610 + Width = 1095 + End + Begin VB.CommandButton cmdAuftragsbearbeitung + Caption = "Auftragsbearbeitung" + Height = 375 + Left = 870 + TabIndex = 4 + Top = 2610 + Width = 1605 + End + Begin VB.CommandButton cmdFinish + Caption = "Finish" + Height = 375 + Left = 10620 + TabIndex = 3 + Top = 2610 + Width = 1395 + End + Begin VB.CommandButton cmdMontage + Caption = "Montage" + Height = 375 + Left = 5970 + TabIndex = 2 + Top = 2610 + Width = 855 + End + Begin VB.CommandButton cmdVorfertigung + Caption = "Vorfertigung" + Height = 375 + Left = 4020 + TabIndex = 1 + Top = 2610 + Width = 1005 + End + End + Begin VB.CommandButton cmdCLR + Caption = "Reset" + Height = 375 + Left = 11400 + TabIndex = 46 + Top = 7140 + Width = 735 + End + Begin VB.CommandButton cmdAbbruch + Caption = "Abbrechen" + Height = 375 + Left = 13920 + TabIndex = 15 + Top = 7140 + Width = 1125 + End + Begin MSComctlLib.StatusBar StatusBar1 + Align = 2 'Unten ausrichten + Height = 315 + Left = 0 + TabIndex = 9 + Top = 7770 + Width = 18300 + _ExtentX = 32279 + _ExtentY = 556 + Style = 1 + _Version = 393216 + BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} + NumPanels = 1 + BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} + EndProperty + EndProperty + End + Begin VB.CommandButton cmdClose + Caption = "Schließen" + Height = 375 + Left = 16080 + TabIndex = 8 + Top = 7110 + Width = 1125 + End + Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 + Height = 3495 + Left = 0 + TabIndex = 7 + Top = 3600 + Width = 15255 + _ExtentX = 26908 + _ExtentY = 6165 + _Version = 393216 + ScrollTrack = -1 'True + TextStyleFixed = 3 + AllowUserResizing= 3 + End + Begin VB.TextBox txtEingabe + Height = 285 + Left = 9690 + MultiLine = -1 'True + TabIndex = 33 + Top = 90 + Visible = 0 'False + Width = 1005 + End + Begin VB.CommandButton cmdPrint + Caption = "Drucken" + Height = 375 + Left = 12480 + TabIndex = 35 + Top = 7140 + Width = 1155 + End + Begin VB.Label lblGeprueft + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 7320 + TabIndex = 100 + Top = 7080 + Width = 915 + End + Begin VB.Label lblNichtZuPruefende + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 7305 + TabIndex = 99 + Top = 7425 + Width = 915 + End + Begin VB.Label Label25 + Caption = "nicht zu prüfende ME,FE,FK:" + Height = 225 + Left = 5115 + TabIndex = 98 + Top = 7485 + Width = 2265 + End + Begin VB.Label Label24 + Alignment = 1 'Rechts + Caption = "Wert:" + Height = 225 + Left = 4560 + TabIndex = 84 + Top = 7140 + Width = 495 + End + Begin VB.Label lblSummeWert + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 5100 + TabIndex = 83 + Top = 7080 + Width = 885 + End + Begin VB.Label Label21 + Caption = "davon geprüft:" + Height = 225 + Left = 6090 + TabIndex = 73 + Top = 7140 + Width = 1185 + End + Begin VB.Label lblAutosize + AutoSize = -1 'True + BorderStyle = 1 'Fest Einfach + Height = 255 + Left = 11220 + TabIndex = 49 + Top = 90 + Visible = 0 'False + Width = 945 + End + Begin VB.Label labelGefertigtMenge + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 2100 + TabIndex = 39 + Top = 7080 + Width = 705 + End + Begin VB.Label labelGefertigtLabel + Caption = "gefertigt:" + Height = 255 + Left = 1440 + TabIndex = 38 + Top = 7110 + Width = 615 + End + Begin VB.Label labelOffenLabel + Caption = "offen:" + Height = 255 + Left = 90 + TabIndex = 36 + Top = 7080 + Width = 465 + End + Begin VB.Label lblSummelabel + Caption = "Summe:" + Height = 225 + Left = 2940 + TabIndex = 32 + Top = 7140 + Width = 585 + End + Begin VB.Label lblSumme + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 3570 + TabIndex = 31 + Top = 7080 + Width = 915 + End + Begin VB.Label Label4 + Alignment = 2 'Zentriert + Caption = "Fertigungslisten drucken / anzeigen" + BeginProperty Font + Name = "MS Sans Serif" + Size = 13.5 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 375 + Left = -360 + TabIndex = 6 + Top = 570 + Width = 15015 + End + Begin VB.Label labelOffenWert + Alignment = 1 'Rechts + BorderStyle = 1 'Fest Einfach + Height = 285 + Left = 660 + TabIndex = 37 + Top = 7080 + Width = 705 + End +End +Attribute VB_Name = "frmFertigungslisten" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private Tabs(20) As Integer +Private TabsAuftr(20) As Integer +Private vorfertigung As Boolean + +Private m_DicSpaltenname As Dictionary + + +Private Const RANDLINKS = 10 +Private Const RANDOBEN = 10 +Private Const RANDRECHTS = 5 +Private Const RANDUNTEN = 10 +Private m_strAusblenden As String +Private Const TEXTALLELINIEN = "(alle)" +Private Const TEXTALLELINIEN_OHNE_VS = "(alle ohne VS)" + +Private Const TEXTALLEKURZBEZ = "(alle)" +Private Const TEXTALLETYPEN = "(alle)" + + +Private Const TRENNER1 = ": " ' für Lot +Private Const TRENNER2 = "|" ' für Lot-Liste + +Private Const TEXTALLE = "(alle)" +Private Const TEXTPSEUNDPFL = "PSE + PFL" + +Private Const TEXTALLEKURZBEZWZFK = "WZ + FK" +Private Const TEXTALLEKURZBEZMEFE = "ME + FE" +Private Const TEXTALLEKURZBEZWZFKGE = "WZ + FK + GE" + +Private m_rs As CRecordset + +Private m_eSortierung As enumSortierung +Private m_blnAbbruch As Boolean +Private mlngRecordsFound As Long + + +Private m_intLastX As Integer +Private m_intLastY As Integer +Private m_strLastText As String + +Private mobjExcelApp As Excel.Application +Private mobjExcelWbk As Excel.Workbook +Private mobjExelworksheet As Excel.Worksheet + +' The column selected for sorting. +Private m_SortColumn As Integer + +' The current sort order. +Private m_SortOrder As SortSettings + +Private m_blnIstAlleAuftraege As Boolean + +Private Enum enumSortierung + SortDefault = 0 + SortNennweite = 1 + SortTemperatur = 2 + SortTypBez = 3 + SortKurzBez = 4 + SortLinieVersanddatum = 5 + SortAuftragPosition = 6 + SortIdentNr = 7 + SortSerienNrVon = 8 + SortBemerkung = 9 +End Enum + +Const SCHRIFTTABELLE = 8 + + + +Private Sub chkNurCKD_Click() + If chkNurCKD.Value = vbChecked Then + chkPlus.Value = vbUnchecked + End If + 'Anzeigen m_strAusblenden +End Sub + + + + + + +Private Sub ChkOhnePlus_Click() + If ChkOhnePlus.Enabled = True Then + + chkPlus.Enabled = False + chkPlus.Value = vbUnchecked + DoEvents + chkPlus.Enabled = True + + End If +End Sub + +Private Sub chkPlus_Click() + If chkPlus.Enabled = True Then + If chkPlus.Value = vbChecked Then + chkNurCKD.Value = vbUnchecked + ChkOhnePlus.Enabled = False + ChkOhnePlus.Value = vbUnchecked + DoEvents + ChkOhnePlus.Enabled = True + End If + End If +End Sub + +Private Sub chkRest_Click() + Dim i As Integer + Dim blnSelected As Boolean + If chkRest.Enabled = False Then + Exit Sub + End If + lstFilterTyp.Enabled = False + For i = 0 To lstFilterTyp.ListCount - 1 + If lstFilterTyp.List(i) <> TEXTALLETYPEN Then + blnSelected = lstFilterTyp.Selected(i) + lstFilterTyp.Selected(i) = True + If blnSelected Then + DoEvents + lstFilterTyp.Selected(i) = False + End If + DoEvents + End If + Next + lstFilterTyp.Enabled = True + lstFilterTyp_Change +End Sub + +Private Sub chkSonderlayoutFertigung_Click() + If chkSonderlayoutFertigung.Enabled = False Then Exit Sub + chkVersuch.Enabled = False + chkVersuch.Value = vbUnchecked + chkVersuch.Enabled = True + + If chkSonderlayoutFertigung.Value = vbChecked Then + cmdAuftragsbearbeitung.Enabled = False + cmdSofortauftraege.Enabled = False + cmdEinsatz.Enabled = False + cmdMontage.Enabled = False + cmdPruefen.Enabled = False + cmdRechenwerk.Enabled = False + cmdVersandfertig.Enabled = False + cmdVorfertigung.Enabled = False + + chkSerNrSensus.Enabled = True + chkSerNrKnd.Enabled = True + chkStatistik.Enabled = True + Else + cmdAuftragsbearbeitung.Enabled = True + cmdSofortauftraege.Enabled = True + cmdEinsatz.Enabled = True + cmdMontage.Enabled = True + cmdPruefen.Enabled = True + cmdRechenwerk.Enabled = True + cmdVersandfertig.Enabled = True + cmdVorfertigung.Enabled = True + + chkSerNrSensus.Enabled = True + chkSerNrKnd.Enabled = True + chkStatistik.Enabled = True + + + chkSerNrSensus.Enabled = False + chkSerNrKnd.Enabled = False +' chkStatistik.Enabled = False + + cmbLot.text = "" +' txtAuftragVon.Text = "" +' txtAuftragBis.Text = "" + + End If +End Sub + +Private Sub chkSortierungDesc_Click() + ListeAktualisieren +End Sub + +Private Sub chkSpaltenbreiteAnpassen_Click() + If chkSpaltenbreiteAnpassen.Value = vbChecked Then + AutoSpaltenBreite MSFlexGrid1, lblAutosize + End If + + g_App.Settings.saveStringValue "Fertigungslisten", "Autospaltenbreite", IIf(chkSpaltenbreiteAnpassen.Value, "1", "0") + +End Sub + +Private Sub chkVersuch_Click() + If chkVersuch.Enabled = False Then Exit Sub + + chkSonderlayoutFertigung.Enabled = False + chkSonderlayoutFertigung.Value = vbUnchecked + chkSonderlayoutFertigung.Enabled = True + + + If chkVersuch.Value = vbChecked Then + cmdAuftragsbearbeitung.Enabled = False + cmdVorfertigung.Enabled = False + cmdMontage.Enabled = False + cmdPruefen.Enabled = False + cmdRechenwerk.Enabled = False + cmdVersandfertig.Enabled = False + + + Else + cmdAuftragsbearbeitung.Enabled = True + cmdVorfertigung.Enabled = True + cmdMontage.Enabled = True + cmdPruefen.Enabled = True + cmdRechenwerk.Enabled = True + cmdVersandfertig.Enabled = True + End If + + 'ListeAktualisieren +End Sub + + + + + + + + + + + +Private Sub cmdAuftragNrClear_Click() + txtFilterAuftrag.text = "" + 'Anzeigen m_strAusblenden +End Sub + +Private Sub cmdEinsatz_Click() + cmdMontage.Enabled = False + vorfertigung = False + Anzeigen "E" + cmdMontage.Enabled = True + cmdMontage.SetFocus +End Sub + + + + +Private Sub cmdExcelExport_Click() + cmdExcelExport.Enabled = False + Me.MousePointer = vbHourglass + Call ExcelExport + cmdExcelExport.Enabled = True + Me.MousePointer = vbNormal +End Sub + +'Private Sub cmdHelwan_Click() +' cmdHelwan.Enabled = False +' +' DTPickerVon.Value = DateSerial(Year(Now - 356), 1, 1) +' DTPickerBis.Value = DateSerial(Year(Now + 356), 12, 31) +' +' +' txtFilterKunde.Text = "Helwan" +' chkSonderlayoutFertigung.Value = vbChecked +' chkSerNrKnd.Value = vbChecked +' chkStatistik.Value = vbChecked +' cmbSortierung.ListIndex = enumSortierung.SortAuftragPosition +' +' AnzeigenVersuch ("F") +' +' +' +' cmdHelwan.Enabled = True +'End Sub + + + +Private Sub cmdLaser_Click() + cmdLaser.Enabled = False + vorfertigung = False + + Anzeigen "L" + + cmdLaser.Enabled = True + cmdLaser.SetFocus +End Sub + + + +Private Sub cmdVorauswahllLaser_Click() + Dim i As Integer + + lstAPOrt.Enabled = False + lstFilterTyp.Enabled = False + + For i = 0 To lstAPOrt.ListCount - 1 + Select Case lstAPOrt.List(i) + Case "L1", "L4" + lstAPOrt.Selected(i) = True + Case Else + lstAPOrt.Selected(i) = False + End Select + Next + + For i = 0 To lstFilterTyp.ListCount - 1 + Select Case lstFilterTyp.List(i) + Case "MS", "MMS" + lstFilterTyp.Selected(i) = True + Case Else + lstFilterTyp.Selected(i) = False + End Select + Next + + lstAPOrt.Enabled = True + lstFilterTyp.Enabled = True +End Sub + +Private Sub lstAPOrt_Click() + If lstAPOrt.Enabled = True Then + MSFlexGrid1.Clear + MSFlexGrid1.Rows = 2 + + 'SetIniWert "Listendruck", "Ort", cmbAPOrt.Text + + cmbKurzBez.text = TEXTALLEKURZBEZ + cmbFilterNennweite.text = "" + cmbFilterTemp.text = "" + cmbFilterDruck.text = "" + cmbFilterBaulaenge.text = "" + AktualisiereComboTyp + End If +End Sub + + +Private Sub FillCombo(myCombobox As control, strSpaltenname As String, Optional strWHERE As String = "") + On Error GoTo Errorhandler + + Dim strSql As String + + strWHERE = Replace(strWHERE, "Typ='PSE + PFL'", "(Typ='PSE' or Typ='PFL')") + + If strWHERE <> "" Then + strWHERE = " WHERE " & strWHERE + End If + + strSql = "SELECT DISTINCT " & strSpaltenname & " FROM IdentNr " + '''''strSQL = strSQL & "INNER JOIN Pruefpunkte ON Pruefpunkte.IdentNr = Identnr.IdentNr " + '''''strSQL = strSQL & "INNER JOIN Pruefklasse ON Pruefpunkte.PruefklasseKZ = Pruefklasse.PruefklasseKZ " + + If strWHERE <> "" Then + strSql = strSql & strWHERE + + strSql = strSql & " AND (Identnr.Status = 1 OR Identnr.Status is NULL) " + End If + + strSql = strSql & " order by " & strSpaltenname + Debug.Print strSql + + Dim rs As CRecordset + + Set rs = New CRecordset + rs.openRS strSql, True + Debug.Print strSql + + Do While Not rs.EOF + If rs.getStringValue(strSpaltenname) & "" <> "" Then + myCombobox.AddItem rs.getStringValue(strSpaltenname) + End If + rs.MoveNext + Loop + Exit Sub +Errorhandler: + LogIntoDB "Fehler " & Err.Number & " in FillCombo('" & strSpaltenname & "','" & strWHERE & "'): " & Err.Description, "SoftwareFehler" +End Sub + +Private Sub cmbFilterNennweite_Change() + AktualisiereComboTemp +End Sub + +Private Sub cmbFilterNennweite_Click() + AktualisiereComboTemp +End Sub + +Private Sub cmbFilterTemp_Change() + AktualisiereComboDruck +End Sub + +Private Sub cmbFilterTemp_Click() + AktualisiereComboDruck +End Sub + +Private Sub cmbFilterBaulaenge_Click() + AktualisiereComboBohrbild +End Sub + +Private Sub lstFilterTyp_Change() + Me.MousePointer = vbHourglass + AktualisiereComboNennweite + Me.MousePointer = vbNormal +End Sub + + + +Private Sub cmdClr_Click() + cmdCLR.Enabled = False + + Form_Load + txtFilterAuftrag.text = "" + cmdCLR.Enabled = True +End Sub + +Private Sub cmdDruckNeu_Click() + vorfertigung = False + cmdDruckNeu.Enabled = False + Me.MousePointer = vbHourglass + + + Printer.ScaleTop = -10 + Printer.ScaleLeft = -15 + + Printer.Orientation = cdlLandscape + Call PrintGrid(MSFlexGrid1, 15, 20, 10, 10, "Fertigungsliste", "", 0) + Printer.EndDoc + Printer.Orientation = cdlPortrait + + Me.MousePointer = vbNormal + cmdDruckNeu.Enabled = True +End Sub + +Private Sub cmdInfoTyp_Click() + MultiselectInfoAnzeigen lstFilterTyp, "Sie haben folgende Zählertypen ausgewählt:" +End Sub + +Private Sub cmdRefreshTyp_Click() + Dim strFilter As String + + cmdRefreshTyp.Enabled = False + Me.MousePointer = vbHourglass + + lstFilterTyp.Clear + lstFilterTyp.AddItem TEXTALLETYPEN + + lstFilterTyp.Selected(0) = True + strFilter = GetFilterOrt() + + If cmbFilterNennweite.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Nennweite='" & Val(cmbFilterNennweite.text) & "'" + End If + + If cmbFilterTemp.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Temperatur='" & Val(cmbFilterTemp.text) & "'" + End If + + If cmbFilterDruck.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Druck= " & Val(cmbFilterDruck.text) & " " + End If + + If cmbFilterBaulaenge.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Baulaenge = " & Val(cmbFilterBaulaenge.text) & " " + End If + + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " ((KurzBez = N'WZ') OR (KurzBez = N'ME') OR (KurzBez = N'GE') or (KurzBez = N'FK')) AND Typ <> '#' AND Typ not like 'FUV%' " + + DoEvents + FillCombo lstFilterTyp, "Typ", strFilter + + + AktualisiereComboNennweite + + cmdRefreshTyp.Enabled = True + Me.MousePointer = vbNormal +End Sub + + + +Private Sub Form_KeyPress(KeyAscii As Integer) + If KeyAscii = 27 Then + m_blnAbbruch = True + End If +End Sub + + + + +Private Sub lstFilterTyp_Click() + If lstFilterTyp.Enabled = True Then + chkRest.Enabled = False + chkRest.Value = vbUnchecked + DoEvents + chkRest.Enabled = True + + lstFilterTyp.Enabled = False + Dim i As Integer + Me.MousePointer = vbHourglass + + If lstFilterTyp.Selected(lstFilterTyp.ListIndex) = True Then + Select Case lstFilterTyp.List(lstFilterTyp.ListIndex) + Case TEXTALLETYPEN + For i = 0 To lstFilterTyp.ListCount - 1 + If lstFilterTyp.List(i) <> TEXTALLETYPEN Then + lstFilterTyp.Selected(i) = False + End If + Next + Case Else + For i = 0 To lstFilterTyp.ListCount - 1 + If lstFilterTyp.List(i) = TEXTALLETYPEN Then + lstFilterTyp.Selected(i) = False + End If + Next + End Select + End If + DoEvents + AktualisiereComboNennweite + + AktualisiereComboMetrolog + + lstFilterTyp.Enabled = True + Me.MousePointer = vbNormal + End If +End Sub + +Private Sub cmbSortierung_Click() +' If cmbSortierung.Enabled Then +' ListeAktualisieren +' End If +End Sub + +Private Sub ListeAktualisieren() + Dim lngVal As Long + If MSFlexGrid1.Rows > 2 Then + Anzeigen m_strAusblenden + End If +End Sub + +Private Sub cmdAbbruch_Click() + m_blnAbbruch = True + cmdAbbruch.Enabled = False +End Sub + +Private Sub cmdAuftragInfo_Click() + AuftragsInfoAnzeigen +End Sub + +Private Sub cmdClose_Click() + Unload Me +End Sub + +Private Sub cmdExcel_Click() + vorfertigung = False + Dim x As Integer + Dim y As Integer + Dim strTemp As String + Screen.MousePointer = vbHourglass + cmdExcel.Enabled = False + Clipboard.Clear + + For y = 0 To MSFlexGrid1.Rows - 1 + StatusBar1.SimpleText = "Kopiere Zeile " & y & " in die Zwischenablage." + DoEvents + For x = 0 To MSFlexGrid1.cols - 1 + MSFlexGrid1.col = x + MSFlexGrid1.row = y + strTemp = strTemp & MSFlexGrid1.text + If x < MSFlexGrid1.cols - 1 Then + strTemp = strTemp & vbTab + End If + Next x + strTemp = strTemp & vbCrLf + Next y + + Clipboard.SetText strTemp + StatusBar1.SimpleText = MSFlexGrid1.Rows & " Zeilen wurden in die Zwischenablage kopiert." + cmdExcel.Enabled = True + Screen.MousePointer = vbNormal +End Sub + +Private Sub cmdFinish_Click() + cmdFinish.Enabled = False + vorfertigung = False + Anzeigen "F" + cmdFinish.Enabled = True + cmdFinish.SetFocus +End Sub + + +Private Sub cmdSofortauftraege_Click() + cmdSofortauftraege.Enabled = False + vorfertigung = False + Anzeigen "Sofort" + cmdSofortauftraege.Enabled = True + cmdSofortauftraege.SetFocus +End Sub + + + +Private Sub cmdAuftragsbearbeitung_Click() + cmdAuftragsbearbeitung.Enabled = False + vorfertigung = False + Anzeigen "A" + cmdAuftragsbearbeitung.Enabled = True + cmdAuftragsbearbeitung.SetFocus +End Sub + +Private Sub cmdMontage_Click() + cmdMontage.Enabled = False + vorfertigung = False + Anzeigen "M" + cmdMontage.Enabled = True + cmdMontage.SetFocus +End Sub + +Private Sub cmdPrint_Click() + m_blnAbbruch = False + + StatusBar1.SimpleText = "Die Liste wird gedruckt..." + cmdPrint.Enabled = False + Screen.MousePointer = vbHourglass + Me.Enabled = False + + DoEvents + + If vorfertigung Then + PrintVorfertigung + ElseIf m_strAusblenden = "L" Then + If MsgBox("Möchten Sie die Sonderliste für Laser drucken?", vbYesNo Or vbDefaultButton1) = vbYes Then + Call SonderlisteLaserDrucken + GoTo fertiggedruckt + End If + ElseIf m_blnIstAlleAuftraege = True Then + If chkVersuch.Value = vbChecked Or chkSonderlayoutFertigung.Value = vbChecked Then + FinePrintVersuch + Else + FinePrintGrid + End If + Else + FinePrintAuftragsInfo + End If + +fertiggedruckt: + StatusBar1.SimpleText = "Die Liste wurde gedruckt. Fertig!" + Me.Enabled = True + Screen.MousePointer = vbNormal + cmdPrint.Enabled = True +End Sub + +Private Sub PrintVorfertigung() + Printer.ScaleMode = vbMillimeters + + Dim headers As Variant + headers = Array("Datum", "AuftragNr/Pos", "KundenOrt", "IdentNr", "Menge", "Bezeihnung", "Bohrung", "S", "L", "A", "V", "E", "M", "P", "R", "D", "Bemerkung", "Ort", "FabrikNr") + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + Dim scales As Variant + scales = Array(0, 0, 0, 0.05, 0, 0.4, 0.55, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + ' shares the difference from page width and headers width between headers + Dim fontSize As Variant + fontSize = Array(8, 8, 7, 8, 8, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 8) + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + Dim alignments As Variant + alignments = Array(0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + Dim formats As Variant + formats = Array("dd.MM", Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null) + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + Dim boldnes As Variant + boldnes = Array(True, True, False, True, True, False, False, True, True, True, True, True, True, True, True, True, False, False, True) + ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 + Dim widths(18) As Double + ' 0 To 18: last array index => 19 elements + + Dim r As Integer + Dim c As Integer + Dim currentX As Double + Dim currentY As Double + Dim width As Double + Dim text As String + + Const offsetX = 0.5 + Const offsetY = 0.75 + Const lineW = 0.1 + + currentX = offsetX + + Printer.fontSize = 8 + Printer.FontBold = True + + For c = 0 To 18 + MSFlexGrid1.row = 0 + MSFlexGrid1.col = c + + widths(c) = Round(Printer.TextWidth(headers(c)) + offsetX * 2 + lineW, 2) + width = width + widths(c) + Next + + width = Printer.ScaleWidth - width + + For c = 0 To 18 + widths(c) = widths(c) + width * scales(c) + Next + + Printer.FontBold = True + + Printer.Line (0, 0)-(Printer.ScaleWidth, 0), vbBlack + Printer.Line (0, offsetY)-(Printer.ScaleWidth, offsetY), vbBlack + + currentY = currentY + offsetY + lineW * 2 + + Printer.fontSize = 14 + Printer.FontBold = True + Printer.currentX = currentX + Printer.currentY = currentY + text = "Sensus Auftragsverwaltung - Vorfertigungsliste" + Printer.Print text + + Dim prevH As Integer + prevH = Printer.TextHeight("|") + + Printer.fontSize = 8 + Printer.FontBold = False + text = "Ausdruck vom: " & Format(DateTime.Now, "dd.MM.yyyy hh:mm") + Printer.currentX = Printer.ScaleWidth - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + ((prevH - Printer.TextHeight("|")) / 2) + Printer.Print text + + currentY = currentY + prevH + offsetY * 2 + + Printer.fontSize = 8 + Printer.FontBold = False + Printer.currentX = currentX + Printer.currentY = currentY + text = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.MM.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.MM.yyyy") + Printer.Print text + + Printer.fontSize = 8 + Printer.FontBold = False + text = "Ort: " & lstAPOrt.text + Printer.currentX = Printer.ScaleWidth - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + currentY = currentY + offsetY * 2 + Printer.TextHeight("|") + + Printer.currentX = currentX + Printer.currentY = currentY + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY), vbBlack + currentY = currentY + offsetY + lineW + + Printer.currentX = currentX + Printer.currentY = currentY + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY), vbBlack + currentY = currentY + offsetY + lineW + + Dim tableTopY As Double + tableTopY = currentY - offsetY + + Printer.fontSize = 8 + Printer.FontBold = True + + For c = 0 To MSFlexGrid1.cols - 1 + MSFlexGrid1.row = 0 + MSFlexGrid1.col = c + + text = headers(c) + + Printer.currentX = currentX + Printer.currentY = currentY + + Printer.Print text + + currentX = currentX + widths(c) + Next + + Printer.FontBold = False + + currentX = offsetX + currentY = currentY + Printer.TextHeight("|") + offsetY + + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY), vbActiveBorder + + currentX = offsetX + currentY = currentY + offsetY + + Dim tempX As Double + + For r = 1 To MSFlexGrid1.Rows - 1 + + For c = 0 To MSFlexGrid1.cols - 1 + MSFlexGrid1.row = r + MSFlexGrid1.col = c + + text = Trim(MSFlexGrid1.text) + + If Not IsNull(formats(c)) Then + text = Format(text, formats(c)) + End If + + Printer.FontBold = boldnes(c) + Printer.fontSize = fontSize(c) + + tempX = currentX + + If Not Printer.FontBold Then + tempX = currentX + offsetX + lineW + End If + + If alignments(c) = 1 Then + tempX = (tempX + widths(c)) - (Printer.TextWidth(text) + offsetX * 2) + End If + + Printer.currentX = tempX + Printer.currentY = currentY + Printer.Print PrintText(text, widths(c) - offsetX * 2) + + currentX = currentX + widths(c) + Next + + currentX = offsetX + currentY = currentY + Printer.TextHeight("|") + offsetY + + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY), vbActiveBorder + + currentX = offsetX + currentY = currentY + offsetY + Next + + Printer.Line (0, currentY - offsetY)-(Printer.ScaleWidth, currentY - offsetY), vbBlack + + Dim lineX As Double + + lineX = lineW + currentY = currentY - offsetY - lineW + Printer.Line (lineX - lineW, tableTopY)-(lineX - lineW, currentY), vbActiveBorder + + For c = 0 To MSFlexGrid1.cols - 1 + lineX = lineX + widths(c) + Printer.Line (lineX - lineW, tableTopY)-(lineX - lineW, currentY), vbActiveBorder + Next + + Dim bottomY As Double + bottomY = currentY + offsetY + + currentY = bottomY + currentX = widths(0) + widths(1) + widths(2) + widths(3) + + Printer.fontSize = 8 + Printer.FontBold = True + text = "Summe:" + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + currentX = currentX + widths(4) + + Printer.fontSize = 8 + Printer.FontBold = True + text = lblSumme & "" + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + currentX = currentX + widths(4) + + Printer.fontSize = 8 + Printer.FontBold = True + text = "" & lblGeprueft + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + Printer.fontSize = 8 + Printer.FontBold = True + text = " davon geprüft" + Printer.currentX = currentX + offsetX + lineW + Printer.currentY = currentY + Printer.Print text + + currentX = currentX - widths(4) * 2 + currentY = currentY + Printer.TextHeight("|") + offsetY + + Printer.fontSize = 8 + Printer.FontBold = True + text = "nicht zu prüfende ME, FE, FK:" + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + currentX = currentX + widths(4) + + Printer.fontSize = 8 + Printer.FontBold = True + text = "" & lblNichtZuPruefende + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + currentX = currentX + widths(4) + + Printer.fontSize = 8 + Printer.FontBold = True + text = "" & (CInt(lblSumme) - CInt(lblGeprueft)) + Printer.currentX = currentX - Printer.TextWidth(text) - offsetX + Printer.currentY = currentY + Printer.Print text + + Printer.fontSize = 8 + Printer.FontBold = True + text = " noch zuprüfen" + Printer.currentX = currentX + offsetX + lineW + Printer.currentY = currentY + Printer.Print text + + currentX = currentX - widths(4) + currentY = currentY + offsetY + lineW + Printer.TextHeight("|") + Printer.Line (currentX, bottomY - offsetY - lineW)-(currentX, currentY), vbActiveBorder + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY) + + currentY = currentY + offsetY + lineW + Printer.Line (0, currentY)-(Printer.ScaleWidth, currentY) + + Printer.EndDoc +End Sub + +Private Function PrintText(text As String, width As Double) As String + While Printer.TextWidth(text) >= width + text = Left(text, Len(text) - 1) + Wend + PrintText = text +End Function + + +Private Sub cmdPruefen_Click() + cmdPruefen.Enabled = False + vorfertigung = False + Anzeigen "P" + cmdPruefen.Enabled = True + cmdPruefen.SetFocus +End Sub + +Private Sub cmdRechenwerk_Click() + cmdRechenwerk.Enabled = False + vorfertigung = False + Anzeigen "R" + cmdRechenwerk.Enabled = True + cmdRechenwerk.SetFocus +End Sub + +Private Sub cmdVersandfertig_Click() + cmdVersandfertig.Enabled = False + vorfertigung = False + Anzeigen "VF" + cmdVersandfertig.Enabled = True + cmdVersandfertig.SetFocus +End Sub + +Private Sub cmdVorfertigung_Click() + cmdVorfertigung.Enabled = False + vorfertigung = True + Anzeigen "V" + cmdVorfertigung.Enabled = True + cmdVorfertigung.SetFocus +End Sub + + + +Private Sub DTPickerVon_Change() + SetIniWert "Listendruck", "DatumVon", DTPickerVon.Value +End Sub + +Private Sub DTPickerBis_Change() + SetIniWert "Listendruck", "DatumBis", DTPickerBis.Value +End Sub + +Private Sub Form_Activate() + On Error Resume Next + cmdFinish.SetFocus +End Sub + +Private Sub Form_Load() + Dim i As Integer + + Screen.MousePointer = vbHourglass + DoEvents + Me.Visible = True + + ResetForm + + cmbKurzBez.Clear + cmbKurzBez.AddItem TEXTALLEKURZBEZ + cmbKurzBez.ListIndex = cmbKurzBez.ListCount - 1 + cmbKurzBez.AddItem TEXTALLEKURZBEZWZFK + cmbKurzBez.AddItem TEXTALLEKURZBEZMEFE + cmbKurzBez.AddItem TEXTALLEKURZBEZWZFKGE + + cmbSortierung.Enabled = False + cmbSortierung.Clear + cmbSortierung.AddItem "Fert.Datum", enumSortierung.SortDefault + cmbSortierung.AddItem "Nennweite", enumSortierung.SortNennweite + cmbSortierung.AddItem "Temperatur", enumSortierung.SortTemperatur + cmbSortierung.AddItem "Typ / Bezeichnung", enumSortierung.SortTypBez + cmbSortierung.AddItem "Kurzbezeichnung", enumSortierung.SortKurzBez + cmbSortierung.AddItem "Linie / Fert.Datum", enumSortierung.SortLinieVersanddatum + cmbSortierung.AddItem "Auftrag / Position", enumSortierung.SortAuftragPosition + cmbSortierung.AddItem "IdentNr", enumSortierung.SortIdentNr + cmbSortierung.AddItem "SerNr von", enumSortierung.SortSerienNrVon + cmbSortierung.AddItem "Bemerkung", enumSortierung.SortBemerkung + cmbSortierung.ListIndex = enumSortierung.SortDefault + cmbSortierung.Enabled = True + + cmbAnzahlKopien.AddItem 1 + cmbAnzahlKopien.AddItem 2 + cmbAnzahlKopien.AddItem 3 + cmbAnzahlKopien.AddItem 4 + cmbAnzahlKopien.AddItem 5 + cmbAnzahlKopien.ListIndex = 0 + + If g_App.Mitarbeiter.getName = "Nettemann" Then + chkVersuch.Enabled = False + chkVersuch.Value = vbChecked + chkVersuch.Enabled = True + End If + + lstAPOrt.Enabled = False + + + fillLstAPOrt + lstAPOrt.Enabled = True + + + Call AktualisiereComboTyp + + DTPickerVon.Value = GetIniWert("Listendruck", "DatumVon", Format(Now(), "dd.mm.yyyy")) + DTPickerBis.Value = Format(Now(), "dd.mm.yyyy") + + MSFlexGrid1.cols = 1 + MSFlexGrid1.FixedCols = 0 + MSFlexGrid1.cols = 0 + cmdAbbruch.Enabled = False + + If g_App.Settings.readStringValue("Fertigungslisten", "Autospaltenbreite", "0") = "1" Then + chkSpaltenbreiteAnpassen.Value = vbChecked + End If + + Call UpdateTabs + + TabsAuftr(0) = 0 ' Versanddatum (10) + TabsAuftr(1) = TabsAuftr(0) + 10 ' Pos (10) + TabsAuftr(2) = TabsAuftr(1) + 10 ' IdentNr (15) + TabsAuftr(3) = TabsAuftr(2) + 15 ' Menge (13) + TabsAuftr(4) = TabsAuftr(3) + 10 ' Bezeichnung (35) + TabsAuftr(5) = TabsAuftr(4) + 35 ' Bohrung (23) + TabsAuftr(6) = TabsAuftr(5) + 17 ' MID (5) + TabsAuftr(7) = TabsAuftr(6) + 3 ' L (2) + TabsAuftr(8) = TabsAuftr(7) + 2 ' A (2) + TabsAuftr(9) = TabsAuftr(8) + 2 ' V (2) + TabsAuftr(10) = TabsAuftr(9) + 2 ' E (2) + TabsAuftr(11) = TabsAuftr(10) + 2 ' M (2) + TabsAuftr(12) = TabsAuftr(11) + 2 ' P (2) + TabsAuftr(13) = TabsAuftr(12) + 2 ' R (2) + TabsAuftr(14) = TabsAuftr(13) + 2 ' D (2) + TabsAuftr(15) = TabsAuftr(14) + 4 ' Anzeige (15) + TabsAuftr(16) = TabsAuftr(15) + 15 ' Bemerkung (20) + TabsAuftr(17) = TabsAuftr(16) + 20 ' Status (15) + TabsAuftr(18) = TabsAuftr(17) + 15 ' FA-Nr (15) + TabsAuftr(19) = TabsAuftr(18) + 15 ' Ort/Linie (5) + TabsAuftr(20) = TabsAuftr(19) + 5 ' Ende + + ' Start with no column sorted. + m_SortColumn = -1 + + + MSFlexGrid1.ToolTipText = "Klicken Sie in eines der Felder um " + MSFlexGrid1.ToolTipText = MSFlexGrid1.ToolTipText & " die Ausgabe nach einer AuftragNr oder Kunden zu filtern, " + MSFlexGrid1.ToolTipText = MSFlexGrid1.ToolTipText & " oder um einen Wert vollständig anzuzeigen und in die Zwischenablage zu kopieren." + + 'g_App.Settings.saveStringValue "Fertigungslisten", "Lots", "" + + If g_App.Settings.readStringValue("Fertigungslisten", "Lots", "") = "" Then + g_App.Settings.saveStringValue "Fertigungslisten", "Lots", "Lot 1 " & TRENNER1 & " 71083499 - 71084977" + End If + + ResetLot + + cmdExcel.Enabled = False + Screen.MousePointer = vbNormal +End Sub + +Private Sub ResetForm() + cmdAuftragsbearbeitung.Enabled = True + + cmdAuftragsbearbeitung.Enabled = True + cmdSofortauftraege.Enabled = True + cmdEinsatz.Enabled = True + cmdMontage.Enabled = True + cmdPruefen.Enabled = True + cmdRechenwerk.Enabled = True + cmdVersandfertig.Enabled = True + cmdVorfertigung.Enabled = True + + + + chkDebug.Value = vbUnchecked + chkVersandIstDatumStattSerienNr.Value = vbUnchecked + chkSortierungDesc.Value = vbUnchecked + chkVersuch.Value = vbUnchecked + chkSpaltenbreiteAnpassen.Value = vbUnchecked + chkSonderlayoutFertigung.Value = vbUnchecked + chkSerNrSensus.Value = vbUnchecked + chkSerNrKnd.Value = vbUnchecked + chkStatistik.Value = vbUnchecked + chkNurCKD.Value = vbUnchecked + chkPlus = vbUnchecked + ChkOhnePlus = vbUnchecked + chkRest = vbUnchecked + chkNoMoskauBadger.Value = vbUnchecked + + txtFilterAuftrag.text = "" + txtFilterKunde.text = "" + + cmbSortierung.Enabled = False + cmbSortierung.ListIndex = -1 + cmbSortierung.Enabled = True + + cmbAnzahlKopien.ListIndex = -1 + + lblSumme.Caption = "" + lblGeprueft.Caption = "" + labelGefertigtMenge.Caption = "" + labelOffenWert.Caption = "" + lblSummeWert.Caption = "" +End Sub + +Private Sub UpdateTabs() + If chkVersuch.Value = vbUnchecked And chkSonderlayoutFertigung.Value = vbUnchecked Then + Tabs(0) = 0 ' Versanddatum bzw. Fert.Datum + Tabs(1) = Tabs(0) + 6 ' Auftrag/Pos + Tabs(2) = Tabs(1) + 19 ' Ort des Kunden + Tabs(3) = Tabs(2) + 15 ' IdentNr + Tabs(4) = Tabs(3) + 14 ' Menge + Tabs(5) = Tabs(4) + 10 ' Bezeichnung + Tabs(6) = Tabs(5) + 38 ' Bohrung + Tabs(7) = Tabs(6) + 22 ' MID (4) + Tabs(8) = Tabs(7) + 4 ' L 3 + Tabs(9) = Tabs(8) + 2 ' A (3) + Tabs(10) = Tabs(9) + 2 ' V (3) + Tabs(11) = Tabs(10) + 2 ' E (3) + Tabs(12) = Tabs(11) + 2 ' M (3) + Tabs(13) = Tabs(12) + 3 ' P (3) + Tabs(14) = Tabs(13) + 2 ' R (3) + Tabs(15) = Tabs(14) + 2 ' D (3) + Tabs(16) = Tabs(15) + 3 ' Anzeige + Tabs(17) = Tabs(16) + 13 ' Bemerkung + Tabs(18) = Tabs(17) + 17 ' Linie / FA + Tabs(19) = Tabs(18) + 5 ' FA-Nr. + Tabs(20) = Tabs(19) + 12 ' 200 + ElseIf chkVersuch.Value = vbChecked Then + + Tabs(0) = 0 ' Versanddatum (10) bzw Fert.Datum + Tabs(1) = 10 ' Auftrag/Pos (22) + Tabs(2) = 32 ' IdentNr (15) + Tabs(3) = 47 ' Menge (13) + Tabs(4) = 60 ' Bezeichnung (40) + Tabs(5) = 100 'SerienNrVon + Tabs(6) = 115 'SerienNrBis + Tabs(7) = 135 'Anzeige + Tabs(8) = 150 'Bemerkung + Tabs(9) = 170 'ZusatzText + Tabs(10) = 200 'Ende + + Tabs(11) = 200 ' + Tabs(12) = 200 + Tabs(13) = 200 + Tabs(14) = 200 + Tabs(15) = 200 + Tabs(16) = 200 + ElseIf chkSonderlayoutFertigung.Value = vbChecked Then + Tabs(0) = 0 ' Versanddatum bzw. Fert.Datum (10) + Tabs(1) = 10 ' Auftrag/Pos (22) + Tabs(2) = 32 ' IdentNr (15) + Tabs(3) = 47 ' Menge (13) + Tabs(4) = 60 ' Bezeichnung (40) + Tabs(5) = 100 'SerienNrVon + Tabs(6) = 115 'SerienNrBis + Tabs(7) = 130 'Knd Ser von - bis + Tabs(8) = 175 'FA-Nr + Tabs(9) = 190 'P + Tabs(10) = 195 'ende + + Tabs(11) = 200 ' + Tabs(12) = 200 + Tabs(13) = 200 + Tabs(14) = 200 + Tabs(15) = 200 + Tabs(16) = 200 + Else + MsgBox "Ungültige Kombination in UpdateTabs()" + End If +End Sub +Private Sub Form_Resize() + Dim lngTopUntereReihe As Long + + If Me.WindowState = vbNormal Then + + If Me.width < Frame1.width Then + ' Formularbreite soll nicht kleiner werden als der Eingabeframe + Me.width = Frame1.width * 1.01 + End If + + If Me.Height < 7000 Then + ' mindest Höhe + Me.Height = 7000 + End If + End If + + lngTopUntereReihe = Me.ScaleHeight - cmdClose.Height - StatusBar1.Height + + + cmdClose.Top = lngTopUntereReihe + cmdClose.Left = Me.ScaleWidth - cmdClose.width * 1.2 + + cmdPrint.Top = lngTopUntereReihe + cmdPrint.Left = Me.ScaleWidth - cmdClose.width * 2.4 + + cmdAbbruch.Top = lngTopUntereReihe + cmdAbbruch.Left = Me.ScaleWidth - cmdClose.width * 3.6 + + cmdCLR.Top = lngTopUntereReihe + cmdCLR.Left = cmdAbbruch.Left - cmdCLR.width * 1.2 + + cmdExcelExport.Top = lngTopUntereReihe + cmdExcelExport.Left = cmdCLR.Left - 1.2 * cmdExcelExport.width + + MSFlexGrid1.width = Me.ScaleWidth * 0.99 + If Me.ScaleHeight - MSFlexGrid1.Top - cmdClose.Height * 2 > 0 Then + MSFlexGrid1.Height = Me.ScaleHeight - MSFlexGrid1.Top - cmdClose.Height * 4 + End If + + lblSumme.Top = MSFlexGrid1.Top + MSFlexGrid1.Height + 8 + + lblSummelabel.Top = lblSumme.Top + labelGefertigtLabel.Top = lblSumme.Top + labelGefertigtMenge.Top = lblSumme.Top + labelOffenLabel.Top = lblSumme.Top + labelOffenWert.Top = lblSumme.Top + + + lblGeprueft.Top = lblSumme.Top + lblSummeWert.Top = lblSumme.Top + lblNichtZuPruefende.Top = lblSumme.Top + lblSumme.Height * 1.5 + + Label21.Top = lblSumme.Top + Label24.Top = lblSumme.Top + Label25.Top = lblNichtZuPruefende.Top + + cmdDruckNeu.Top = cmdExcel.Top + + + Debug.Print Me.width +End Sub + + +Private Sub Anzeigen(strAusblenden As String) + On Error GoTo Errorhandler + UpdateTabs + StatusBar1.SimpleText = "" + + If chkVersuch.Value = vbChecked Or chkSonderlayoutFertigung.Value = vbChecked Then + Call AnzeigenVersuch(strAusblenden) + If chkSpaltenbreiteAnpassen.Value = vbChecked Then + AutoSpaltenBreite MSFlexGrid1, lblAutosize + End If + Exit Sub + End If + + Debug.Print "Anzeigen" + + labelGefertigtMenge.Caption = "" + labelOffenWert.Caption = "" + lblSummeWert.Caption = "" + lblNichtZuPruefende.Caption = "" + + m_blnIstAlleAuftraege = True + + Dim strSql As String + Dim rs As CRecordset + Dim strTemp As String + Dim ZeileAufBlatt As Integer + Dim dblY As Double + + Dim Seite As Integer + + Dim i As Integer + Dim lngSummeMenge As Long + Dim dblLastFontSize As Double + Dim strZusatztext As String + + Dim strAlteLinie As String + Dim strLinie As String + Dim lngFarbe As Long + + Dim lngGeprueft As Long + Dim lngSummeGeprueft As Long + Dim lngSummeNichtZuPruefendeMEFE As Long + + Dim lngAuftragsMenge As Long + Dim strVako As String + Dim objVako As CVakoCode + Dim strAusfuehrung As String + Dim strCSD As String + + m_blnAbbruch = False + cmdAbbruch.Enabled = True + cmdExcel.Enabled = False + + Screen.MousePointer = vbHourglass + DoEvents + + m_strAusblenden = strAusblenden + m_eSortierung = cmbSortierung.ListIndex + + MSFlexGrid1.Clear + MSFlexGrid1.Rows = 1 + MSFlexGrid1.cols = 1 + MSFlexGrid1.FormatString = "" + + MSFlexGrid1.ScrollBars = flexScrollBarBoth + lblSumme.Caption = "" + lblGeprueft.Caption = "" + + MSFlexGrid1.Font = "Courier New" + MSFlexGrid1.Font.Size = 8 + + If chkVersuch.Value = vbChecked Then + MSFlexGrid1.FormatString = " Fert.Dat |AuftragNr/Pos|Kndort| IdentNr |Menge| Bezeichnung | SerienNr-Von|SerienNr-Bis| Anzeige | Bemerkung |ZusatzText" + ElseIf vorfertigung Then + MSFlexGrid1.FormatString = " Datum|AufNr/Pos|Kndort|IdentNr|Menge|Bezeichnung|Bohrung|S|L|A|V|E|M|P|R|D|Bemerkung|Ort|FabNr." + Else + MSFlexGrid1.FormatString = " Fert.Dat |AuftragNr/Pos|Kndort| IdentNr |Menge| Bezeichnung | Bohrung |Info|L|A|V|E|M|P|R|D| Anzeige | Bemerkung |Ort| FA-Nr." + End If + +' strSQL = "SELECT AuftragPosition.AuftragNr, AuftragPosition.PositionNr, AuftragPosition.IdentNr, AuftragPosition.VersandDatum, " +' strSQL = strSQL & " AuftragPosition.FertigungsauftragNr, AuftragPosition.Menge,AuftragPosition.TLMenge, AuftragPosition.Bohrung, AuftragPosition.Farbe, AuftragPosition.Prf_nach_MID, AuftragPosition.Anzeige, AuftragPosition.A_IstTermin, AuftragPosition.V_IstTermin,AuftragPosition.E_IstTermin, " +' strSQL = strSQL & " AuftragPosition.M_IstTermin, AuftragPosition.P_IstTermin, AuftragPosition.R_IstTermin, AuftragPosition.Bem_Fertigung, AuftragPosition.SerienNrVon, AuftragPosition.SerienNrBis, " +' strSQL = strSQL & " AuftragPosition.Bezeichnung, IdentNr.KurzBez, IdentNr.Typ, IdentNr.Typzusatz, IdentNr.Nennweite, IdentNr.Temperatur, IdentNr.Druck, IdentNr.Baulaenge,AuftragPosition.ZusatzText, " +' \\sla12file\auftrag\KarstenSosna\SensusAV\source + + strSql = "SELECT AuftragPosition.* ," + strSql = strSql & " IdentNr.KurzBez, IdentNr.Typ, IdentNr.Typzusatz, IdentNr.Nennweite, IdentNr.Temperatur, IdentNr.Druck, IdentNr.Baulaenge,IdentNr.IdentNrString, IdentNr.VakoCode, IdentNr.SAP_Nummer, AuftragPosition.ZusatzText, " + strSql = strSql & " AuftragPosition.Ort, Kunde.Ort as Kundenort, Kunde.Name, IdentNr.Bestellgruppe , AuftragPosition.Kennzeichen2, AuftragPosition.Kundennr " + + If strAusblenden = "Sofort" Then + strSql = strSql & " , AuftragPositionSerienNr.SerienNr " + End If + + If vorfertigung Then + strSql = strSql & " , ISNULL([VakoMerkmal].[Charcode], 'X') AS [X]" + End If + + strSql = strSql & " FROM AuftragPosition " & vbCrLf + + strSql = strSql & " INNER JOIN Identnr ON AuftragPosition.IdentNr = Identnr.IdentNr" + strSql = strSql & " INNER JOIN Kunde ON AuftragPosition.KundenNr = Kunde.KundenNr" & vbCrLf + + If vorfertigung Then + strSql = strSql & " LEFT JOIN (SELECT [Stelle], [Laenge], [Charcode]" + strSql = strSql & " FROM [VAKO_Merkmale]" + strSql = strSql & " WHERE [Basis] = 'GNS' AND [Name] = 'C_GEN_GEHAEUSEOPTION')" + strSql = strSql & " AS [VakoMerkmal]" + strSql = strSql & " ON [VakoMerkmal].[Charcode] = SUBSTRING([Identnr].[VakoCode], [VakoMerkmal].[Stelle], [VakoMerkmal].[Laenge])" + End If + + If strAusblenden = "Sofort" Then + strSql = strSql & " LEFT OUTER JOIN AuftragPositionSerienNr ON AuftragPosition.AuftragNr = AuftragPositionSerienNr.AuftragNr " + strSql = strSql & " AND AuftragPosition.PositionNr = AuftragPositionSerienNr.PositionNr" + End If + + strSql = strSql & " WHERE (AuftragPosition.VersandDatum >= CONVERT(DATETIME, '" & Format(DTPickerVon.Value, "yyyy-mm-dd") & " 00:00:00', 102)) AND" + strSql = strSql & " (AuftragPosition.VersandDatum <= CONVERT(DATETIME, '" & Format(DTPickerBis.Value, "yyyy-mm-dd") & " 23:59:59', 102)) " + + If strAusblenden = "Sofort" Then + strSql = strSql & " AND AuftragPositionSerienNr.SerienNr is null" + End If + + If cmbFilterMetrolog.text <> TEXTALLE Then + strSql = strSql & " AND AuftragPosition.Metrolog = '" & cmbFilterMetrolog.text & "' " + End If + + + strSql = strSql & " AND " & GetFilterOrt("AuftragPosition.Ort") + + + If Val(txtAuftragVon.text) > 0 Then + strSql = strSql & " AND AuftragNr >= " & Val(txtAuftragVon.text) & " " + End If + + If Val(txtAuftragVon.text) > 0 Then + strSql = strSql & " AND AuftragNr <= " & Val(txtAuftragBis.text) & " " + End If + + + ' Lot 3 Sonderregel: darf nicht Lot 2 enthalten! + If Val(txtAuftragVon.text) = 71085275 And Val(txtAuftragBis.text) = 71086275 Then + strSql = strSql & " AND not (AuftragNr >= 71085331 and AuftragNr <= 71085336) " + End If + + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strSQL = strSQL & " AND AuftragPosition.Ort <> 'VS' " +' Else +' strSQL = strSQL & " AND AuftragPosition.Ort ='" & cmbAPOrt.Text & "' " +' End If +' Else +' ' alle Linien +' End If + + Select Case cmbKurzBez.text + Case TEXTALLEKURZBEZMEFE + strSql = strSql & " AND (Identnr.KurzBez = 'ME' or Identnr.KurzBez = 'FE')" + Case TEXTALLEKURZBEZWZFK + strSql = strSql & " AND (Identnr.KurzBez = 'WZ' or Identnr.KurzBez = 'FK')" + Case TEXTALLEKURZBEZWZFKGE + strSql = strSql & " AND (Identnr.KurzBez = 'WZ' or Identnr.KurzBez = 'FK' or Identnr.KurzBez = 'GE')" + Case Else + strSql = strSql & " AND (Identnr.KurzBez <> 'ET')" + End Select + + Select Case strAusblenden + Case "A" + strSql = strSql & " AND A_IstTermin is NULL " + Case "V" + strSql = strSql & " AND V_IstTermin is NULL And Identnr.KurzBez <> 'ME' " + Case "E" + strSql = strSql & " AND E_IstTermin is NULL " + Case "M" + strSql = strSql & " AND M_IstTermin is NULL " + Case "P" + strSql = strSql & " AND P_IstTermin is NULL AND Identnr.KurzBez <> 'FK' AND Identnr.KurzBez <> 'FE'" + Case "R" + strSql = strSql & " AND R_IstTermin is NULL AND (Identnr.typ = 'PSE' OR Identnr.typ = 'PFL') " + Case "VF" + strSql = strSql & " AND P_IstTermin is NOT NULL " + m_eSortierung = SortLinieVersanddatum + Case "L" + strSql = strSql & " AND L_IstTermin is NULL " + Case "F" + ' alle anzeigen + + Case "Sofort" + strSql = strSql & " AND (Identnr.KurzBez = 'ME' or Identnr.KurzBez = 'WZ') AND AuftragPosition.FertigungsauftragNr is NULL AND Auftragposition.KundenNr <> 38045 " + End Select + + If Val(txtFilterAuftrag.text) > 0 Then + strSql = strSql & " AND (AuftragPosition.AuftragNr = " & Val(txtFilterAuftrag.text) & " OR AuftragPosition.FertigungsauftragNr = " & Val(txtFilterAuftrag.text) & " or AuftragPosition.AuftragNr = " & Val(txtFilterAuftrag.text) & " ) " + End If + + If Len(Trim(txtFilterKunde.text)) > 0 Then + If Val(txtFilterKunde.text) > 0 Then + strSql = strSql & " AND AuftragPosition.KundenNr = " & Val(txtFilterKunde.text) & " " + Else + strSql = strSql & " AND (Kunde.Name like '%" & Replace(txtFilterKunde.text, "'", "''") & "%' " + strSql = strSql & " OR Kunde.Ort like '%" & Replace(txtFilterKunde.text, "'", "''") & "%') " + End If + End If + + If GetFilterForTyp <> "" Then + strSql = strSql & " AND " & GetFilterForTyp + End If + + If cmbFilterNennweite.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Nennweite = " & Val(cmbFilterNennweite.text) & " " + End If + + If cmbFilterTemp.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Temperatur= " & Val(cmbFilterTemp.text) & " " + End If + + If cmbFilterDruck.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Druck= " & Val(cmbFilterDruck.text) & " " + End If + + If cmbFilterBaulaenge.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Baulaenge = " & Val(cmbFilterBaulaenge.text) & " " + End If + + If cmbFilterBohrbild.text <> TEXTALLE Then + strSql = strSql & " AND AuftragPosition.Bohrung like '%" & cmbFilterBohrbild.text & "%' " + End If + + + If chkPlus.Value = vbChecked Then + strSql = strSql & " AND IdentNr.Typzusatz = N'Plus' " + End If + + If ChkOhnePlus.Value = vbChecked Then + strSql = strSql & " AND (IdentNr.Typzusatz <> N'Plus' or IdentNr.Typzusatz is NULL) " + End If + + If chkNurCKD.Value = vbChecked Then + strSql = strSql & " AND AuftragPosition.Bezeichnung like N'CKD%' " + End If + + If chkNoMoskauBadger.Value = vbChecked Then + strSql = strSql & " AND (Kunde.KundenNr <> 38116 and Kunde.KundenNr <> 38045) " + End If + + If chkNurMID Then + strSql = strSql & " AND ZusatzText LIKE '%Zulassungskennzeichen : MID%' " + End If + + If chkOhneLager.Value = vbChecked Then + strSql = strSql & " AND Kunde.KundenNr <> 1000" + End If + + If chkNur_eRegister.Value = vbChecked Then + strSql = strSql & " and AuftragPosition.FertigungsauftragNr in (SELECT FertigungsauftragNr from VIEW_eRegister_Infos) and Identnr.VakoCode is not null " & vbCrLf + End If + + strSql = strSql & vbCrLf + + Select Case m_eSortierung + Case enumSortierung.SortKurzBez + strSql = strSql & " ORDER BY Identnr.KurzBez " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ",IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + Case enumSortierung.SortNennweite + strSql = strSql & " ORDER BY IdentNr.Nennweite " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Temperatur " + Case enumSortierung.SortTemperatur + strSql = strSql & " ORDER BY IdentNr.Temperatur " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite " + Case enumSortierung.SortTypBez + strSql = strSql & " ORDER BY IdentNr.Typ " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ",IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + Case enumSortierung.SortLinieVersanddatum + strSql = strSql & " ORDER BY AuftragPosition.Ort, VersandDatum " + Case enumSortierung.SortAuftragPosition + strSql = strSql & " ORDER BY AuftragPosition.AuftragNr " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", AuftragPosition.PositionNr " + Case enumSortierung.SortIdentNr + strSql = strSql & " ORDER BY AuftragPosition.IdentNr " + Case enumSortierung.SortSerienNrVon + strSql = strSql & " ORDER BY AuftragPosition.SerienNrVon " + Case enumSortierung.SortBemerkung + strSql = strSql & " ORDER BY AuftragPosition.Bem_Fertigung " + Case Else + strSql = strSql & " ORDER BY AuftragPosition.VersandDatum " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + End Select + If chkSortierungDesc.Value = vbChecked Then + strSql = strSql & " DESC" + End If + + If chkStatistik.Value = vbChecked Then + strSql = Replace(strSql, "AuftragPosition", "AlleAuftragPositionen") + End If + + + Debug.Print strSql + + Set rs = New CRecordset + + rs.openRS strSql, True + + + MSFlexGrid1.Rows = 2 + mlngRecordsFound = 0 + lngSummeMenge = 0 + lngSummeGeprueft = 0 + + If Not rs.EOF Then + Do While Not rs.EOF + + '''''''''''''''''''''''' Vakocode auswerten ''''''''''''''''''''''' + strCSD = "" + strAusfuehrung = "" + strVako = rs.getStringValue("VakoCode") + Set objVako = Nothing + If Len(strVako) > 0 Then + Set objVako = New CVakoCode + objVako.Load strVako + + strAusfuehrung = objVako.GetWert("Ausfuehrung") + If Left(strAusfuehrung, 4) = "CSD " Then + strCSD = Split(strAusfuehrung, " ")(0) & " " & Split(strAusfuehrung, " ")(1) + strCSD = Replace(strCSD, "_C&I", "") + Else + strCSD = "" + End If + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + cmdExcel.Enabled = True + + mlngRecordsFound = mlngRecordsFound + 1 + MSFlexGrid1.row = MSFlexGrid1.Rows - 1 + + MSFlexGrid1.col = 0 + ' wenn man nach einer nicht numerischen Spalte sortieren, die aber numerisch anfängt, sortieren möchte, muss ein Space vor dem Anfag stehen + MSFlexGrid1.text = " " & Format(rs.getLongValue("Versanddatum"), "yyyy-mm-dd") + + MSFlexGrid1.col = 1 + MSFlexGrid1.text = " " & rs.getLongValue("AuftragNr") & "/" & rs.getLongValue("PositionNr") + ' wenn man nach einer nicht numerischen Spalte sortieren, die aber numerisch anfängt, sortieren möchte, muss ein Space vor dem Anfag stehen + + MSFlexGrid1.col = 2 + MSFlexGrid1.text = rs.getStringValue("Kundenort") + + + '''''''''''''''''''''''''''''''''''''''''''''''''''' + ' Kundenort je nach CSD ändern + '''''''''''''''''''''''''''''''''''''''''''''''''''' + ' Auf Wunsch von Uwe Kubon am 2021-01-18 + If strCSD = "CSD 38042_MK" Then + MSFlexGrid1.text = rs.getStringValue("Kundenort") & "/MK" + '''''''''''' + ' Auf Wunsch von Uwe Kubon am 2021-05-18 + ' Moin Reinhard, wenn i.O, bitte den o.g. Kundenort "Singapore" - Kd.-Nr. 772161 für die SAV-Übersicht (z.B. Listendruck) + ' in "Singapore/Korea" umbenennen, wenn das "CSD 48982 DIMIT Korea" (39/38) konfiguriert wurde. + ' Mail von Weber, Andreas Dienstag, 18. Mai 2021 12:52 + ' "Singapore/Korea" = gemäß CSD 48982 DIMIT Korea + ' Der neue Bestellprozess über Xylem, Singapur betrifft alle 3 Kunden aus Süd Korea, DMIT, WIZIT u. DRTECH (DURECOM) + ElseIf strCSD = "CSD 48982" Then + ' CSD 48982 DMIT (DIMIT) Korea + MSFlexGrid1.text = rs.getStringValue("Kundenort") & "/Korea-DMIT" + ElseIf strCSD = "CSD 38033" Then + ' CSD 38033 Wizit Korea + MSFlexGrid1.text = rs.getStringValue("Kundenort") & "/Korea-Wizit" + ElseIf strCSD = "CSD 765700" Then + ' CSD 765700 Durecom Korea + MSFlexGrid1.text = rs.getStringValue("Kundenort") & "/Korea-Durecom" + End If + '''''' + + MSFlexGrid1.col = 3 + + Dim strVariantencode As String + Dim strIdentnrString As String + + MSFlexGrid1.text = getIdentNrTextFromRecordset(rs, strAusblenden) + +' strIdentnrString = Trim(rs.getStringValue("IdentnrString")) +' Select Case strIdentnrString +' ' Sonderbehandlung +' Case "MODULMEI", "MODUL" +' ' soll ersetzt werden durch Material aus Tabelle Material_Variantencode über Variantencode, falls vorhanden +' ' Variantencode auslesen +' strVariantencode = GetWertFromZusatztext(rs.getStringValue("Zusatztext"), "Bestellcode " & strIdentnrString & " :") +' If strVariantencode <> "" Then +' ' Variantencode ist vorhanden +' ' Material aus Tabelle Material_Variantencode auslesen +' strTemp = getMaterialFromVariantencode(strVariantencode, strIdentnrString) +' If strTemp = "" Then +' ' Material ist nicht vorhanden: Fallback auf IdentnrString +' strTemp = rs.getStringValue("IdentnrString") +' End If +' Else +' ' Variantencode ist NICHT vorhanden, KonfigMat = IdentNrstring anzeigen +' ' Fallback auf IdentnrString +' strTemp = strIdentnrString +' End If +' ' Tabellenzelle füllen +' MSFlexGrid1.Text = strTemp +' Case "" +' If strAusblenden = "Sofort" Then +' MSFlexGrid1.Text = rs.getStringValue("Kennzeichen") & rs.getLongValue("IdentNr") & rs.getStringValue("Kennzeichen2") +' Else +' If rs.getLongValue("Kundennr") = 1000 And Len(rs.getStringValue("Kennzeichen2")) > 0 Then +' MSFlexGrid1.Text = rs.getLongValue("IdentNr") & rs.getStringValue("Kennzeichen2") +' Else +' Select Case rs.getLongValue("IdentNr") +' Case 2100000 +' MSFlexGrid1.Text = "MODUL*" +' Case Else +' MSFlexGrid1.Text = rs.getLongValue("IdentNr") +' End Select +' End If +' End If +' Case Else +' MSFlexGrid1.Text = strIdentnrString +' End Select +' If rs.getStringValue("SAP_Nummer") <> "" Then +' MSFlexGrid1.Text = rs.getStringValue("SAP_Nummer") +' End If + + + + MSFlexGrid1.col = 4 + lngAuftragsMenge = rs.getLongValue("Menge") + If rs.getLongValue("TLMenge") = 0 Then + ' es wurde bisher noch keine Teilmenge fertiggemeldet + MSFlexGrid1.text = rs.getLongValue("Menge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") + Else + ' Es wurde eine Teilmenge fertiggemeldet + MSFlexGrid1.text = "R " & rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + End If + + strZusatztext = Replace(rs.getStringValue("Zusatztext"), vbCrLf, "| ") + MSFlexGrid1.col = 5 + MSFlexGrid1.ColAlignment(5) = flexAlignLeftCenter + + + ' If InStr(1, UCase(strZusatztext), UCase("MS Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' ElseIf InStr(1, UCase(strZusatztext), UCase("MeiStream Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' Else + + Dim Temperatur As Integer + Temperatur = rs.getIntValue("Temperatur") + + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + If Not objVako Is Nothing Then + '''''''''''''''''''''''' Testen ob Kältezähler ''''''''''''''''''''''' + If Left(strVako, 3) = "PST" Then + If objVako.GetWert("Kaeltezaehler") <> "" Then + Temperatur = 50 + 'Debug.Print objVako.GetWert("Kaeltezaehler") + 'MSFlexGrid1.Text = Trim(MSFlexGrid1.Text & " KÄLTEZÄHLER !") + End If + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + + + ' RH 19.5.2008: CKD Sonderbehandlung + MSFlexGrid1.text = IIf((Left(rs.getStringValue("Bezeichnung"), 3) = "CKD"), "CKD ", "") & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(Temperatur) & "°C PN" & rs.getIntValue("Druck") + ' End If + + If Not rs.isFieldNull("Baulaenge") Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & rs.getLongValue("Baulaenge") + Else + 'Baulänge evtl über Bestellcode bestimmen + strTemp = GetBaulaengeFromAuftragposition(rs.getLongValue("AuftragNr"), rs.getLongValue("PositionNr"), rs.getLongValue("Bestellgruppe")) + If strTemp <> "" Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & strTemp + End If + End If + + + If chkVersuch.Value = vbUnchecked Then + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 6 + MSFlexGrid1.text = Replace(rs.getStringValue("Bohrung"), "Bohrbild", "") + + ' 3.11.2009 Gibt Prüfung nach MID + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + + If vorfertigung Then + On Error Resume Next + If rs.getStringValue("X") <> "X" Then ' Drucksensor + MSFlexGrid1.text = "S" + End If + ElseIf InStr(1, rs.getStringValue("ZusatzText"), "Zulassungskennzeichen : MID") > 0 Or rs.getBooleanValue("Prf_nach_MID") Then + MSFlexGrid1.text = "MID" + ' neu RH 15.3.2012 + ElseIf rs.getStringValue("Metrolog") = "MID" Then + MSFlexGrid1.text = "MID" + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "L") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "A") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 8 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "V") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 9 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "E") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "M") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 11 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "P") + + If IstZaehlerUngeprueft(rs) Then + ' - TLMenge eingebaut 2020-06-17 für Uwe Kubon: abzüglich der bereits fertiggemeldeten Filter und ungeprüften ME + lngSummeNichtZuPruefendeMEFE = lngSummeNichtZuPruefendeMEFE + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + MSFlexGrid1.text = "-" + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 12 + MSFlexGrid1.text = GetAVEMPR_Spaltenwert(rs, "R") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 13 + Dim lngAnzahlDruckprf As Long + lngAnzahlDruckprf = AnzahlDruckGepruefterZaehler(rs.getLongValue("AuftragNr"), rs.getLongValue("PositionNr")) + If lngAnzahlDruckprf >= lngAuftragsMenge Then + If lngAnzahlDruckprf = lngAuftragsMenge Then + MSFlexGrid1.text = "D" + Else + MSFlexGrid1.text = "d" + End If + End If + +' MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 14 +' If rs.getLongValue("TLMenge_G") >= lngAuftragsMenge Then +' MSFlexGrid1.Text = "G" +' End If + + Else + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 6 + MSFlexGrid1.text = rs.getStringValue("SerienNrVon") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + MSFlexGrid1.text = rs.getStringValue("SerienNrBis") + End If + + If Not vorfertigung Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 13 oder 8 + MSFlexGrid1.text = Trim(rs.getStringValue("Anzeige")) + + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "eRegister") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " E" + End If + End If + + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "Encoder") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " Enc" + End If + End If + End If + + + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + '' Bem_Fertigung '' + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 14 oder 9 + MSFlexGrid1.text = GetBemerkungText(rs, lngSummeGeprueft) + + + '''''''''''''''''''''''' Vakocode auswerten ''''''''''''''''''''''' + + If Not objVako Is Nothing Then + '''''''''''''''''''''''' Testen ob Kältezähler ''''''''''''''''''''''' + If Left(strVako, 3) = "PST" Then + If objVako.GetWert("Kaeltezaehler") <> "" Then + MSFlexGrid1.text = Trim(MSFlexGrid1.text & " KÄLTEZÄHLER !") + End If + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + + If chkVersuch.Value = vbChecked Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 + MSFlexGrid1.text = AddToTextIfNotExists(MSFlexGrid1.text, Trim(Replace(rs.getStringValue("ZusatzText"), vbCrLf, " "))) + End If + + + + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + ' Ende Bem_Fertigung + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + + If chkVersuch.Value = vbUnchecked Then + 'If cmbAPOrt.Text = TEXTALLELINIEN Or cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then + 'End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 15 + MSFlexGrid1.text = Trim(rs.getStringValue("Ort")) + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 16 oder 14? + MSFlexGrid1.text = Trim(rs.getStringValue("FertigungsauftragNr")) + End If + +MoveToNextDatensatz: + rs.MoveNext + + If Not rs.EOF Then + MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1 + End If + + StatusBar1.SimpleText = MSFlexGrid1.Rows - 1 & "/" & rs.RecordCount & " Positionen" + DoEvents + + If m_blnAbbruch Then + Call Abbruch + cmdAbbruch.Enabled = False + Exit Sub + End If + + ' Zwischenstand anzeigen + lblSumme.Caption = lngSummeMenge + lblGeprueft.Caption = lngSummeGeprueft + lblNichtZuPruefende.Caption = lngSummeNichtZuPruefendeMEFE + + DoEvents + + Loop + SetSpalteNameZuordnung + Else + StatusBar1.SimpleText = "keine passenden Datensätze" + End If + + ' Endsummen anzeigen + lblSumme.Caption = lngSummeMenge + lblGeprueft.Caption = lngSummeGeprueft + lblNichtZuPruefende.Caption = lngSummeNichtZuPruefendeMEFE + + If chkSpaltenbreiteAnpassen.Value = vbChecked Then + AutoSpaltenBreite MSFlexGrid1, lblAutosize + End If + + cmdAbbruch.Enabled = False + Me.Enabled = True + Screen.MousePointer = vbNormal +Exit Sub +Errorhandler: + LogIntoDB "Fehler " & Err.Number & " in frmFertigungslisten.Anzeigen(): " & Err.Description, "Softwarefehler" + cmdAbbruch.Enabled = False + Me.Enabled = True + Screen.MousePointer = vbNormal + Exit Sub + Resume +End Sub + +Private Function IstZaehlerUngeprueft(rs As CRecordset) As Boolean + If (InStr(1, rs.getStringValue("Zusatztext"), "ohne (ungeprüft)") > 0 Or rs.getStringValue("KurzBez") = "FE" Or rs.getStringValue("KurzBez") = "FK") Then + IstZaehlerUngeprueft = True + End If +End Function + + ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + ' + ' DRUCKEN + ' + ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +' If ChkDrucker.Value = vbChecked And mlngRecordsFound > 0 Then +' Printer.ColorMode = 2 +' Printer.Copies = Val(cmbAnzahlKopien.Text) +' +' Printer.Font = "Arial" +' Printer.ScaleMode = vbMillimeters +' +' Printer.ScaleLeft = -4 ' Rand +' Printer.ScaleTop = -1 ' Rand +' +' '''''''''''''''''Seiten Kopf +' Seite = 1 +' Printer.CurrentY = 5 +' Printer.Line (0, Int(Printer.CurrentY))-(Tabs(15), Int(Printer.CurrentY)) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.CurrentX = 5 +' Printer.Font.Size = 15 +' Printer.Font.Bold = True +' +' +' Printer.FontTransparent = True +' dblY = Printer.CurrentY +' Printer.Print GetUeberschrift(strAusblenden) +' +' Printer.Font.Size = SCHRIFTTABELLE +' Printer.Font.Bold = False +' +' Printer.CurrentY = dblY +' Printer.CurrentX = 130 +' Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") +' Printer.CurrentY = Printer.CurrentY + 15 - SCHRIFTTABELLE +' +' Printer.CurrentY = Printer.CurrentY + 1 +' +' Printer.CurrentX = 10 +' strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") +' +' +' Printer.Print strTemp +' +' strTemp = "Ort: " & cmbAPOrt.Text +' +' If txtFilterKunde.Text <> "" Then +' strTemp = strTemp & ", Kunden-Nr: " & txtFilterKunde.Text & ", " +' End If +' +' If cmbKurzBez.Text <> TEXTALLEKURZBEZ Then +' Printer.FontBold = True +' If strTemp <> "" Then strTemp = strTemp & ", nur " +' strTemp = strTemp & cmbKurzBez.Text +' End If +' +' If lstFilterTyp.Text <> TEXTALLETYPEN Then +' Printer.FontBold = True +' If strTemp <> "" Then strTemp = strTemp & ", " +' For i = 0 To lstFilterTyp.ListCount - 1 +' If lstFilterTyp.Selected(i) = True Then +' strTemp = strTemp & lstFilterTyp.List(i) & ", " +' End If +' Next +' End If +' +' +' If cmbFilterNennweite.Text <> TEXTALLE Then +' Printer.FontBold = True +' strTemp = strTemp & " DN " & cmbFilterNennweite +' End If +' +' If cmbFilterTemp.Text <> TEXTALLE Then +' Printer.FontBold = True +' strTemp = strTemp & " " & cmbFilterTemp & "°C " +' End If +' +' If cmbFilterDruck.Text <> TEXTALLE Then +' Printer.FontBold = True +' strTemp = strTemp & " PN " & cmbFilterDruck & " " +' End If +' +' If strAusblenden = "P" Then +' strTemp = strTemp & ", keine FK u. FE " +' End If +' +' If strAusblenden = "R" Then +' strTemp = strTemp & ", nur PFL u. PSE " +' End If +' +' Printer.CurrentX = 10 +' Printer.Print strTemp +' Printer.FontBold = False +' +' Printer.CurrentY = Printer.CurrentY + 3 +' +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' +' Dim zeile As Integer +' +' ''''''''''''' Tabellenkopf +' Printer.CurrentY = Printer.CurrentY + 3 +' Call Tabellenkopf +' +' ' Obere Kante der Tabelle merken +' dblY = Printer.CurrentY + 8 +' ZeileAufBlatt = 0 +' +' ' Spalten Linien +' 'For i = 0 To 13 +' ' Printer.Line (Tabs(i), dblY)-(Tabs(i), 270) +' 'Next +' +' Printer.CurrentY = dblY - 8 +' +' +' For zeile = 1 To mlngRecordsFound +' ZeileAufBlatt = ZeileAufBlatt + 1 +' +' If Printer.CurrentY > 270 Then +' ' Zeile passt nicht mehr aufs Blatt +' +' ZeileAufBlatt = 1 +' Call SeitenFuss(strAusblenden, Seite) +' +' Printer.NewPage +' Printer.Font.Size = SCHRIFTTABELLE +' +' Seite = Seite + 1 +' StatusBar1.SimpleText = "Drucke Seite " & Seite +' DoEvents +' +' Printer.CurrentY = 5 +' Call Tabellenkopf +' ' Obere Kante der Tabelle +' dblY = Printer.CurrentY + 8 +' End If +' +' Printer.CurrentY = dblY +' +' For i = 0 To MSFlexGrid1.Cols - 1 +' Printer.CurrentY = dblY + (ZeileAufBlatt - 2) * 5 +' MSFlexGrid1.row = zeile +' MSFlexGrid1.Col = i +' strTemp = Trim(MSFlexGrid1.Text) +' Printer.Font.Size = 8 +' Printer.Font.Bold = False +' Select Case i +' Case 0 +' 'Versanddatum +' Printer.Font.Bold = True +' strTemp = Format(CDate(strTemp), "dd.mm") +' Case 1 +' ' AuftragNr/Pos +' Printer.Font.Bold = True +' Case 2 +' 'Kunden Ort +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 3 +' 'IdentNr +' Printer.Font.Bold = True +' Case 4 +' 'Menge +' Printer.Font.Bold = True +' Case 5 +' ' Bezeichnung +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 6 +' ' Bohrung +' strTemp = Textformat(strTemp, i) +' Printer.Font.Size = 6 +' Case 7, 8, 9, 10, 11 ' AVMPR +' Printer.Font.Bold = True +' Case 12 ' Anzeige +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 13 ' Bemerkung +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 15 +' strTemp = "" +' End Select +' +' If chkVersuch.Value = vbChecked Then +' Select Case i +' Case 6, 7 +' ' SerienNrVon +' Printer.Font.Size = 8 +' Printer.Font.Bold = True +' Case 8 ' Anzeige +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 9 ' Bemerkung +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 10 +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Printer.CurrentY = Printer.CurrentY + 1 +' End Select +' End If +' +' Printer.CurrentX = Tabs(i) +' +' Select Case i +' Case 1, 3 +' ' rechtsbündig +' Printer.CurrentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 +' Case 0, 4 +' ' rechtsbündig +' Printer.CurrentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 2 +' End Select +' +' Select Case i +' Case 13 +' ' Bemerkung +' Printer.CurrentY = Printer.CurrentY - 2 +' Printer.CurrentX = Tabs(i) +' Printer.Print Left(strTemp, 10) +' Printer.CurrentX = Tabs(i) +' Printer.Print Mid(strTemp, 11) +' Printer.CurrentY = Printer.CurrentY + 1 +' Case Else +' Printer.Print strTemp +' End Select +' +' dblLastFontSize = Printer.Font.Size +' Printer.Font.Size = 8 +' Next +' +' ' da letzte Spalte eine kleinere Schriftgroesse haben könnte +' 'Printer.CurrentY = Printer.CurrentY + 2 +' Printer.DrawWidth = 3 +' +' If zeile < mlngRecordsFound Then +' If strAusblenden <> "VF" Then +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' Else +' If MSFlexGrid1.Cols > 14 Then +' ' es gibt Spalte Linie +' strLinie = MSFlexGrid1.TextMatrix(zeile + 1, 14) +' If zeile > 1 Then +' strAlteLinie = MSFlexGrid1.TextMatrix(zeile, 14) +' Else +' strAlteLinie = strLinie +' End If +' +' If strAlteLinie <> strLinie Then +' Printer.DrawStyle = vbSolid +' lngFarbe = RGB(0, 0, 0) +' Else +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' End If +' Else +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' End If +' End If +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY), lngFarbe +' Else +' Printer.DrawStyle = vbSolid +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 2 +' Printer.Font.Bold = True +' strTemp = "Summe " & lngSummeMenge +' Printer.CurrentX = Tabs(4 + 1) - Printer.TextWidth(strTemp) - 2 +' Printer.Print strTemp +' End If +' +' +' DoEvents +' If m_blnAbbruch Then +' Call Abbruch +' Exit Sub +' End If +' Next +' +' Printer.CurrentY = Printer.CurrentY + 3 +' If Printer.CurrentY < 278 Then +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.Line (0, Printer.CurrentY + 1)-(Tabs(15), Printer.CurrentY + 1) +' End If +' +' SeitenFuss strAusblenden, Seite, " von " & Seite & " Seiten" +' If m_blnAbbruch Then +' Call Abbruch +' Exit Sub +' End If +' +' Printer.EndDoc +' MsgBox "Die Liste wurde gedruckt!" +' End If + + + +' +' MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 14 oder 9 +' MSFlexGrid1.Text = Trim(rs.getStringValue("Bem_Fertigung")) +' +' If chkVersuch.Value = vbChecked Then +' MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, Trim(Replace(rs.getStringValue("ZusatzText"), vbCrLf, " "))) +' End If +' +' If Not rs.isFieldNull("R_IstTermin") And rs.isFieldNull("P_IstTermin") Then +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, "R:" & Format(rs.getDateValue("R_IstTermin"), "dd.mm")) +' End If +' +' lngGeprueft = 0 +' If rs.getLongValue("TLMenge_P") > 0 Then +' ' TL_Menge_P ist gesetzt (neu) +' lngGeprueft = rs.getLongValue("TLMenge_P") - rs.getLongValue("TLMenge") +' If rs.getLongValue("TLMenge_P") < rs.getLongValue("Menge") Then +' ' Teilmenge anzeigen +' strTemp = "P=" & rs.getLongValue("TLMenge_P") +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, strTemp) +' Else +' If Not rs.isFieldNull("P_IstTermin") Then +' ' schon komplett geprüft +' strTemp = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, strTemp) +' End If +' End If +' Else +' ' TL_Menge_P ist noch nicht gesetzt (alt) +' If Not rs.isFieldNull("P_IstTermin") Then +' ' Komplett an der Prüfstation fertiggemeldet +' strTemp = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, strTemp) +' lngGeprueft = rs.getLongValue("Menge") - rs.getLongValue("TLMenge") +' End If +' End If +' lngSummeGeprueft = lngSummeGeprueft + lngGeprueft +' If lngGeprueft > rs.getLongValue("Menge") Then +' LogIntoDB "fertigungslisten Anzeigen(): TLMenge_P > Menge !", "Datenfehler" +' End If +' +' ' neu RH 12.06.2007 Für Ort ZY soll die Farbe angezeigt werden, da die Temperatur = NULL ist +' If rs.getStringValue("Ort") = "ZY" And rs.getStringValue("Farbe") <> "" Then +' If MSFlexGrid1.Text <> "" Then MSFlexGrid1.Text = MSFlexGrid1.Text & "," +' MSFlexGrid1.Text = AddToTextIfNotExists(MSFlexGrid1.Text, rs.getStringValue("Farbe")) +' End If + + +Private Function AddToTextIfNotExists(strOldText As String, strNewText As String) As String + Debug.Print strOldText & " +'" & strNewText & "'" + AddToTextIfNotExists = strOldText + If InStr(1, strOldText, strNewText) = 0 Then + If strOldText <> "" Then + AddToTextIfNotExists = strOldText & ", " + End If + AddToTextIfNotExists = AddToTextIfNotExists & strNewText + End If +End Function + +Private Function GetAVEMPR_Spaltenwert(rs As CRecordset, strPrefix As String) As String + GetAVEMPR_Spaltenwert = "" + If rs.getDateValue(strPrefix & "_IstTermin") > 0 Then + GetAVEMPR_Spaltenwert = strPrefix +' If rs.getLongValue("TLMenge_" & strPrefix) > 0 And rs.getLongValue("TLMenge_" & strPrefix) < rs.getLongValue("Menge") Then +' GetAVEMPR_Spaltenwert = "#" +' End If + Else + If rs.getLongValue("TLMenge_" & strPrefix) > 0 And rs.getLongValue("TLMenge_" & strPrefix) < rs.getLongValue("Menge") Then + ' Teilmenge wurde fertiggemeldet + GetAVEMPR_Spaltenwert = "*" + Else + ' noch gar nichts fertiggemeldet + End If + End If +End Function + +Private Sub AnzeigenVersuch(strAusblenden As String) + UpdateTabs + + Debug.Print "AnzeigenVersuch" + + StatusBar1.SimpleText = "" + + labelGefertigtMenge.Caption = "" + labelOffenWert.Caption = "" + lblSumme.Caption = "" + lblSummeWert.Caption = "" + lblGeprueft.Caption = "" + lblNichtZuPruefende.Caption = "" + + m_blnIstAlleAuftraege = True + + Dim strSql As String + Dim rs As CRecordset + Dim strTemp As String + Dim ZeileAufBlatt As Integer + Dim dblY As Double + + Dim strVako As String + Dim objVako As CVakoCode + + Dim Seite As Integer + Dim i As Integer + Dim lngSummeMenge As Long + Dim lngSummeWert As Long + Dim lngSummeGefertigt As Long + Dim lngSummeGeprueft As Long + Dim lngSummeNichtZuPruefendeMEFE As Long + Dim lngGeprueft As Long + Dim strHerkunft As String + + Dim dblLastFontSize As Double + + Dim strAlteLinie As String + Dim strLinie As String + Dim lngFarbe As Long + + mlngRecordsFound = 0 + m_blnAbbruch = False + cmdAbbruch.Enabled = True + cmdExcel.Enabled = False + + Screen.MousePointer = vbHourglass + DoEvents + + m_strAusblenden = strAusblenden + m_eSortierung = cmbSortierung.ListIndex + + MSFlexGrid1.Clear + MSFlexGrid1.Rows = 1 + MSFlexGrid1.cols = 1 + MSFlexGrid1.FormatString = "" + + MSFlexGrid1.ScrollBars = flexScrollBarBoth + + MSFlexGrid1.Font = "Courier New" + MSFlexGrid1.Font.Size = 8 + + If chkSonderlayoutFertigung.Value = vbChecked Then + Dim strTempSNr As String + + strTempSNr = " Fert.Dat |AuftragNr|Pos|IdentNr |Menge| Bezeichnung | " + If chkSerNrSensus.Value = vbChecked Then + strTempSNr = strTempSNr & "SerNr von|SerNr bis|" + End If + If chkSerNrKnd.Value = vbChecked Then + If chkVersandIstDatumStattSerienNr.Value = vbChecked Then + strTempSNr = strTempSNr & " Kndeig.SNr / Versand|" + Else + strTempSNr = strTempSNr & " Kndeig.SNr von - bis|" + End If + End If + strTempSNr = strTempSNr & " FA-Nr|P|Wert" + + If chkStatistik.Value = vbChecked Then + strTempSNr = strTempSNr & "|St" + End If + + If chkDebug.Value = vbChecked Then + strTempSNr = strTempSNr & "|gepr" + End If + + MSFlexGrid1.FormatString = strTempSNr + Else + MSFlexGrid1.FormatString = " Fert.Dat |AuftragNr / Pos|IdentNr |Menge| Bezeichnung | SerNr von|SerNr bis| Anzeige | Bemerkung |ZusatzText" + End If + + strSql = "SELECT AuftragPosition.AuftragNr, AuftragPosition.PositionNr, AuftragPosition.IdentNr, AuftragPosition.VersandDatum, AuftragPosition.Wert, " + strSql = strSql & " AuftragPosition.FertigungsauftragNr, AuftragPosition.Menge,AuftragPosition.TLMenge, AuftragPosition.Bohrung, AuftragPosition.Farbe, AuftragPosition.Anzeige, AuftragPosition.A_IstTermin, AuftragPosition.V_IstTermin, AuftragPosition.Versand_Ist_datum, " + strSql = strSql & " AuftragPosition.M_IstTermin, AuftragPosition.P_IstTermin, AuftragPosition.R_IstTermin, AuftragPosition.Bem_Fertigung, AuftragPosition.SerienNrVon, AuftragPosition.SerienNrBis, AuftragPosition.Bestellcode, AuftragPosition.TLMenge_P, " + strSql = strSql & " AuftragPosition.Bezeichnung , IdentNr.VakoCode, IdentNr.KurzBez, IdentNr.Typ, IdentNr.Typzusatz, IdentNr.Nennweite, IdentNr.Temperatur, IdentNr.Druck, IdentNr.Baulaenge, AuftragPosition.ZusatzText, IdentNr.Bestellgruppe, IdentNr.SAP_Nummer, " + strSql = strSql & " AuftragPosition.Ort, Kunde.Ort as Kundenort, Kunde.Name as KundenName, Kunde.KundenNr " + + If chkStatistik.Value = vbChecked And chkSonderlayoutFertigung.Value = vbChecked Then + strSql = strSql & " , AuftragPosition.Herkunft " + End If + + strSql = strSql & " FROM AuftragPosition " & vbCrLf + + strSql = strSql & " INNER JOIN Identnr ON AuftragPosition.IdentNr = Identnr.IdentNr" + strSql = strSql & " INNER JOIN Kunde ON AuftragPosition.KundenNr = Kunde.KundenNr" & vbCrLf + + strSql = strSql & " WHERE (AuftragPosition.VersandDatum >= CONVERT(DATETIME, '" & Format(DTPickerVon.Value, "yyyy-mm-dd") & " 00:00:00', 102)) AND" + strSql = strSql & " (AuftragPosition.VersandDatum <= CONVERT(DATETIME, '" & Format(DTPickerBis.Value, "yyyy-mm-dd") & " 23:59:59', 102)) " + + strTemp = GetFilterOrt("AuftragPosition.Ort") + If strTemp <> "" Then + strSql = strSql & " AND " & strTemp + End If + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strSQL = strSQL & "AND AuftragPosition.Ort <> 'VS' " +' Else +' strSQL = strSQL & " AND AuftragPosition.Ort = '" & cmbAPOrt.Text & "' " +' End If +' Else +' ' alle Linien +' End If + + + If Val(txtAuftragVon.text) > 0 Then + strSql = strSql & " AND AuftragNr >= " & Val(txtAuftragVon.text) & " " + End If + + If Val(txtAuftragVon.text) > 0 Then + strSql = strSql & " AND AuftragNr <= " & Val(txtAuftragBis.text) & " " + End If + + ' Lot 3 Sonderregel: darf nicht Lot 2 enthalten! + If Val(txtAuftragVon.text) = 71085275 And Val(txtAuftragBis.text) = 71086275 Then + strSql = strSql & " AND not (AuftragNr >= 71085331 and AuftragNr <= 71085336) " + End If + + + If chkNurMID Then + strSql = strSql & " AND ZusatzText LIKE '%Zulassungskennzeichen : MID%' " + End If + + Select Case cmbKurzBez.text + Case TEXTALLEKURZBEZMEFE + strSql = strSql & " AND (Identnr.KurzBez = 'ME' or Identnr.KurzBez = 'FE')" + Case TEXTALLEKURZBEZWZFK + strSql = strSql & " AND (Identnr.KurzBez = 'WZ' or Identnr.KurzBez = 'FK')" + Case TEXTALLEKURZBEZWZFKGE + strSql = strSql & " AND (Identnr.KurzBez = 'WZ' or Identnr.KurzBez = 'FK' or Identnr.KurzBez = 'GE')" + Case Else + strSql = strSql & " AND (Identnr.KurzBez <> 'ET')" + End Select + + Select Case strAusblenden + Case "A" + strSql = strSql & " AND A_IstTermin is NULL " + Case "V" + strSql = strSql & " AND V_IstTermin is NULL " + Case "E" + strSql = strSql & " AND E_IstTermin is NULL " + Case "M" + strSql = strSql & " AND M_IstTermin is NULL " + Case "P" + strSql = strSql & " AND P_IstTermin is NULL AND Identnr.KurzBez <> 'FK' AND Identnr.KurzBez <> 'FE'" + Case "R" + strSql = strSql & " AND R_IstTermin is NULL AND (Identnr.typ = 'PSE' OR Identnr.typ = 'PFL') " + Case "VF" + strSql = strSql & " AND P_IstTermin is NOT NULL " + m_eSortierung = SortLinieVersanddatum + Case "F" + ' alle anzeigen + End Select + + If Val(txtFilterAuftrag.text) > 0 Then + strSql = strSql & " AND (AuftragPosition.AuftragNr = " & Val(txtFilterAuftrag.text) & " OR AuftragPosition.FertigungsauftragNr = " & Val(txtFilterAuftrag.text) & ") " + End If + + If Len(Trim(txtFilterKunde.text)) > 0 Then + If Val(txtFilterKunde.text) > 0 Then + strSql = strSql & " AND AuftragPosition.KundenNr = " & Val(txtFilterKunde.text) & " " + Else + strSql = strSql & " AND (Kunde.Name like '%" & Replace(txtFilterKunde.text, "'", "''") & "%' " + strSql = strSql & " OR Kunde.Ort like '%" & Replace(txtFilterKunde.text, "'", "''") & "%') " + End If + End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strSql = strSql & " AND " & GetFilterForTyp() + End If + + If cmbFilterNennweite.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Nennweite = " & Val(cmbFilterNennweite.text) & " " + End If + + If cmbFilterTemp.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Temperatur= " & Val(cmbFilterTemp.text) & " " + End If + + If cmbFilterDruck.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Druck= " & Val(cmbFilterDruck.text) & " " + End If + + If cmbFilterBaulaenge.text <> TEXTALLE Then + strSql = strSql & " AND IdentNr.Baulaenge = " & Val(cmbFilterBaulaenge.text) & " " + End If + + + If cmbFilterBohrbild.text <> TEXTALLE Then + strSql = strSql & " AND AuftragPosition.Bohrung like '%" & cmbFilterBohrbild.text & "%' " + End If + + + If chkPlus.Value = vbChecked Then + strSql = strSql & " AND IdentNr.Typzusatz = N'Plus' " + End If + + If ChkOhnePlus.Value = vbChecked Then + strSql = strSql & " AND (IdentNr.Typzusatz <> N'Plus' or IdentNr.Typzusatz IS NULL) " + End If + + If chkNurCKD.Value = vbChecked Then + strSql = strSql & " AND AuftragPosition.Bezeichnung like N'CKD%' " + End If + + If chkNoMoskauBadger.Value = vbChecked Then + strSql = strSql & " AND (Kunde.KundenNr <> 38116 and Kunde.KundenNr <> 38045) " + End If + + strSql = strSql & vbCrLf + + Select Case m_eSortierung + Case enumSortierung.SortKurzBez + strSql = strSql & " ORDER BY Identnr.KurzBez " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ",IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + Case enumSortierung.SortNennweite + strSql = strSql & " ORDER BY IdentNr.Nennweite " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Temperatur " + Case enumSortierung.SortTemperatur + strSql = strSql & " ORDER BY IdentNr.Temperatur " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite " + Case enumSortierung.SortTypBez + strSql = strSql & " ORDER BY IdentNr.Typ " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ",IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + Case enumSortierung.SortLinieVersanddatum + strSql = strSql & " ORDER BY AuftragPosition.Ort, VersandDatum " + Case enumSortierung.SortAuftragPosition + strSql = strSql & " ORDER BY AuftragPosition.AuftragNr " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", AuftragPosition.PositionNr " + Case enumSortierung.SortIdentNr + strSql = strSql & " ORDER BY AuftragPosition.IdentNr " + Case enumSortierung.SortSerienNrVon + strSql = strSql & " ORDER BY AuftragPosition.SerienNrVon " + Case enumSortierung.SortBemerkung + strSql = strSql & " ORDER BY AuftragPosition.Bem_Fertigung " + Case Else + strSql = strSql & " ORDER BY AuftragPosition.VersandDatum " & IIf(chkSortierungDesc.Value = vbUnchecked, "", "DESC") & ", IdentNr.Typ,IdentNr.TypZusatz,IdentNr.Nennweite,IdentNr.Temperatur " + End Select + If chkSortierungDesc.Value = vbChecked Then + strSql = strSql & " DESC" + End If + + + If chkStatistik.Value = vbChecked Then + strSql = Replace(strSql, "AuftragPosition", "AlleAuftragPositionen") + End If + + + Debug.Print strSql + + Set rs = New CRecordset + rs.openRS strSql, True + Set m_rs = rs + + MSFlexGrid1.Rows = 2 + mlngRecordsFound = 0 + lngSummeMenge = 0 + + Dim strWert As String + Dim strRem As String + + If Not rs.EOF Then + Do While Not rs.EOF + + '''''''''''''''''''''''' Vakocode auswerten ''''''''''''''''''''''' + Set objVako = Nothing + strVako = Trim(rs.getStringValue("VakoCode")) + If Len(strVako) > 0 Then + Set objVako = New CVakoCode + objVako.Load strVako + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + + cmdExcel.Enabled = True + + mlngRecordsFound = mlngRecordsFound + 1 + MSFlexGrid1.row = MSFlexGrid1.Rows - 1 + + MSFlexGrid1.col = 0 + 'MSFlexGrid1.Text = Format(rs.getLongValue("Versanddatum"), "dd.mm.yyyy") + MSFlexGrid1.text = Format(rs.getLongValue("Versanddatum"), "yyyy-mm-dd") + + If chkSonderlayoutFertigung.Value = vbChecked Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = rs.getLongValue("AuftragNr") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = rs.getLongValue("PositionNr") + Else + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = rs.getLongValue("AuftragNr") & "/" & rs.getLongValue("PositionNr") + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = rs.getLongValue("IdentNr") + + lngGeprueft = 0 + strRem = "" + + ' Menge + MSFlexGrid1.col = MSFlexGrid1.col + 1 + If chkStatistik.Value = vbChecked And chkSonderlayoutFertigung.Value = vbChecked Then + ' Statistik wird berücksichtigt + If InStr(1, rs.getStringValue("Herkunft"), "Statistik") > 0 Then + ' Es handelt sich um den Datensatz aus der Statistik + If rs.getLongValue("TLMenge") = 0 Then + ' gibt es doch eigentlich nicht!!!!!!!!!!! + ' + ' es wurde noch keine Teilmenge fertiggemeldet + MSFlexGrid1.text = "0" + ' der Wert wird mit der Auftragsposition angezeigt + strWert = "" + lngGeprueft = "" + strRem = "St -> s. AP Menge=" & rs.getLongValue("Menge") + ElseIf rs.getLongValue("TLMenge") = rs.getLongValue("Menge") Then + ' es wurde die volle Teilmenge fertiggemeldet + MSFlexGrid1.text = rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("TLMenge") + strWert = rs.getLongValue("Wert") + labelGefertigtMenge.Caption = Val(labelGefertigtMenge.Caption) + rs.getLongValue("TLMenge") + + lngGeprueft = rs.getLongValue("TLMenge") + strRem = "TLMenge=Menge=" & lngGeprueft + Else + ' es wurde bereits eine Teilmenge fertiggemeldet, + MSFlexGrid1.text = rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("TLMenge") + ' der Wert wird mit der Auftragsposition angezeigt + strWert = "" + labelGefertigtMenge.Caption = Val(labelGefertigtMenge.Caption) + rs.getLongValue("TLMenge") + + If rs.getLongValue("TLMenge_P") > 0 Then + strRem = "St -> s. AP Menge=" & rs.getLongValue("Menge") + lngGeprueft = 0 + Else + lngGeprueft = rs.getLongValue("TLMenge") + strRem = "TLMenge=" & rs.getLongValue("TLMenge") & " / Menge=" & rs.getLongValue("TLMenge") + End If + End If + Else + ' Es handelt sich um den Datensatz aus der Auftragposition + + If rs.getLongValue("TLMenge_P") > 0 Then + ' TL_Menge_P ist gesetzt (neu) + lngGeprueft = rs.getLongValue("TLMenge_P") + strRem = " TLMenge_P=" & lngGeprueft + Else + strRem = " TLMenge_P=0" + End If + + + If chkSonderlayoutFertigung.Value = vbChecked Then + strWert = rs.getLongValue("Wert") + End If + + If rs.getLongValue("TLMenge") = 0 Then + ' es wurde noch keine Teilmenge fertiggemeldet + MSFlexGrid1.text = rs.getLongValue("Menge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") + Else + ' es wurde bereits eine Teilmenge fertiggemeldet + ' verbleibene Menge + MSFlexGrid1.text = "R " & rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + End If + End If + Else + ' Statistik wird nicht berücksichtigt + + If rs.getLongValue("TLMenge_P") > 0 Then + ' TL_Menge_P ist gesetzt (neu) + lngGeprueft = rs.getLongValue("TLMenge_P") + strRem = "TLMenge_P=" & lngGeprueft + End If + 'if rs.getLongValue("") + + If chkSonderlayoutFertigung.Value = vbChecked Then + strWert = rs.getLongValue("Wert") + End If + + If rs.getLongValue("TLMenge") = 0 Then + MSFlexGrid1.text = rs.getLongValue("Menge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") + Else + MSFlexGrid1.text = "R " & rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + labelGefertigtMenge.Caption = Val(labelGefertigtMenge.Caption) + rs.getLongValue("TLMenge") + End If + lblSumme.Caption = lngSummeMenge + End If + + lngSummeGeprueft = lngSummeGeprueft + lngGeprueft + lblGeprueft.Caption = lngSummeGeprueft + + + If chkStatistik.Value = vbChecked And chkSonderlayoutFertigung.Value = vbChecked Then + If rs.getStringValue("Herkunft") = "AuftragPosition" Then + If rs.getLongValue("TLMenge") = 0 Then + labelOffenWert.Caption = Val(labelOffenWert.Caption) + rs.getLongValue("Menge") + Else + labelOffenWert.Caption = Val(labelOffenWert.Caption) + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + End If + End If + End If + + lngSummeWert = lngSummeWert + Val(strWert) + lblSummeWert.Caption = lngSummeWert + DoEvents + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.ColAlignment(4) = flexAlignLeftCenter + + ' If InStr(1, UCase(rs.getStringValue("ZusatzText")), UCase("MS Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' ElseIf InStr(1, UCase(rs.getStringValue("Typ")), UCase("MeiStream Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' Else + MSFlexGrid1.text = IIf((Left(rs.getStringValue("Bezeichnung"), 3) = "CKD"), "CKD ", "") & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + 'MSFlexGrid1.Text = rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' End If + + + If Not rs.isFieldNull("Baulaenge") Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & rs.getLongValue("Baulaenge") + Else + strTemp = GetBaulaengeFromAuftragposition(rs.getLongValue("AuftragNr"), rs.getLongValue("PositionNr"), rs.getLongValue("Bestellgruppe")) + If strTemp <> "" Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & strTemp + End If + End If + + If chkSonderlayoutFertigung.Value = vbChecked Then + If chkSerNrSensus.Value = vbChecked Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 6 + MSFlexGrid1.text = rs.getStringValue("SerienNrVon") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + MSFlexGrid1.text = rs.getStringValue("SerienNrBis") + End If + Else + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 6 + MSFlexGrid1.text = rs.getStringValue("SerienNrVon") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 7 + MSFlexGrid1.text = rs.getStringValue("SerienNrBis") + End If + + If chkSonderlayoutFertigung.Value = vbChecked Then + Dim strKndSerienNrVon As String + Dim strKndSerienNrBis As String + + If chkSerNrKnd.Value = vbChecked Then + If chkStatistik.Value = vbChecked Then + + strHerkunft = rs.getStringValue("Herkunft") + End If + + + If chkVersandIstDatumStattSerienNr.Value = vbChecked And InStr(strHerkunft, "Statistik") > 0 Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 9 + 'MSFlexGrid1.Text = Format(rs.getDateValue("Versand_Ist_datum"), "dd.mm.yyyy") + MSFlexGrid1.text = Format(rs.getDateValue("Versand_Ist_datum"), "yyyy-mm-dd") + 'MSFlexGrid1.CellAlignment = vbRightJustify + Else + Call getKundeneigeneSerienNr(rs.getLongValue("AuftragNr"), rs.getLongValue("PositionNr"), strKndSerienNrVon, strKndSerienNrBis) + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 9 + MSFlexGrid1.text = strKndSerienNrVon & "-" & strKndSerienNrBis + MSFlexGrid1.CellAlignment = vbLeftJustify + End If + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 + If rs.isFieldNull("FertigungsauftragNr") Then + MSFlexGrid1.text = "" + Else + MSFlexGrid1.text = rs.getLongValue("FertigungsauftragNr") + End If + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 11 + + If Not rs.isFieldNull("P_IstTermin") Then + MSFlexGrid1.text = "P" + Else + If rs.getLongValue("TLMenge_P") = 0 Then + MSFlexGrid1.text = "" + Else + If rs.getLongValue("TLMenge_P") = rs.getLongValue("Menge") Then + MSFlexGrid1.text = "p" + Else + MSFlexGrid1.text = "*" + End If + End If + End If + + If IstZaehlerUngeprueft(rs) Then + ' - TLMenge eingebaut 2020-06-17 für Uwe Kubon: abzüglich der bereits fertiggemeldeten Filter und ME + lngSummeNichtZuPruefendeMEFE = lngSummeNichtZuPruefendeMEFE + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + MSFlexGrid1.text = "-" + End If + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' + MSFlexGrid1.text = strWert + + If chkStatistik.Value = vbChecked Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 + If InStr(rs.getStringValue("Herkunft"), "Statistik") > 0 Then + MSFlexGrid1.text = "St" + End If + End If + + If chkDebug.Value = vbChecked Then + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' + MSFlexGrid1.text = lngGeprueft + End If + Else + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 8 + MSFlexGrid1.text = Trim(rs.getStringValue("Anzeige")) + + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "eRegister") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " E" + End If + End If + + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "Encoder") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " Enc" + End If + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 9 + MSFlexGrid1.text = Trim(rs.getStringValue("Bem_Fertigung")) + + MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 + MSFlexGrid1.text = Trim(Replace(rs.getStringValue("ZusatzText"), vbCrLf, "| ")) + End If + + rs.MoveNext + + If Not rs.EOF Then + MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1 + End If + + StatusBar1.SimpleText = MSFlexGrid1.Rows - 1 & "/" & rs.RecordCount & " Positionen" + DoEvents + + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + + lblSumme.Caption = lngSummeMenge + lblNichtZuPruefende.Caption = lngSummeNichtZuPruefendeMEFE + DoEvents + + Loop + SetSpalteNameZuordnung + Else + StatusBar1.SimpleText = "keine passenden Datensätze" + End If + + lblSumme.Caption = lngSummeMenge + lblNichtZuPruefende.Caption = lngSummeNichtZuPruefendeMEFE + + + cmdAbbruch.Enabled = False + Me.Enabled = True + Screen.MousePointer = vbNormal +End Sub + +' If ChkDrucker.Value = vbChecked And mlngRecordsFound > 0 Then +' Printer.ColorMode = 2 +' Printer.Copies = Val(cmbAnzahlKopien.Text) +' +' Printer.Font = "Arial" +' Printer.ScaleMode = vbMillimeters +' +' Printer.ScaleLeft = -4 ' Rand +' Printer.ScaleTop = -1 ' Rand +' +' '''''''''''''''''Seiten Kopf +' Seite = 1 +' Printer.CurrentY = 5 +' Printer.Line (0, Int(Printer.CurrentY))-(Tabs(15), Int(Printer.CurrentY)) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.CurrentX = 5 +' Printer.Font.Size = 15 +' Printer.Font.Bold = True +' +' +' Printer.FontTransparent = True +' dblY = Printer.CurrentY +' Printer.Print GetUeberschrift(strAusblenden) +' +' Printer.Font.Size = SCHRIFTTABELLE +' Printer.Font.Bold = False +' +' Printer.CurrentY = dblY +' Printer.CurrentX = 130 +' Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") +' Printer.CurrentY = Printer.CurrentY + 15 - SCHRIFTTABELLE +' +' Printer.CurrentY = Printer.CurrentY + 1 +' +' Printer.CurrentX = 10 +' strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") +' +' +' Printer.Print strTemp +' +' +' strTemp = "Ort: " & cmbAPOrt.Text +' +' If txtFilterKunde.Text <> "" Then +' strTemp = strTemp & ", Kunden-Nr: " & txtFilterKunde.Text +' End If +' +' If cmbKurzBez.Text <> TEXTALLEKURZBEZ Then +' If strTemp <> "" Then strTemp = strTemp & ", nur " +' strTemp = strTemp & cmbKurzBez.Text +' End If +' +' If lstFilterTyp.Text <> TEXTALLETYPEN Then +' For i = 0 To lstFilterTyp.ListCount - 1 +' If strTemp <> "" Then strTemp = strTemp & ", " +' If lstFilterTyp.Selected(i) = True Then +' strTemp = strTemp & lstFilterTyp.List(i) +' End If +' Next +' End If +' +' If cmbFilterNennweite.Text <> TEXTALLE Then +' strTemp = strTemp & " DN " & cmbFilterNennweite +' End If +' +' If cmbFilterTemp.Text <> TEXTALLE Then +' strTemp = strTemp & " " & cmbFilterTemp & "°C " +' End If +' +' If cmbFilterDruck.Text <> TEXTALLE Then +' strTemp = strTemp & " PN " & cmbFilterDruck & " " +' End If +' +' If strAusblenden = "P" Then +' strTemp = strTemp & ", keine FK u. FE " +' End If +' +' If strAusblenden = "R" Then +' strTemp = strTemp & ", nur PFL u. PSE " +' End If +' +' Printer.CurrentX = 10 +' Printer.Print strTemp +' +' +' Printer.CurrentY = Printer.CurrentY + 3 +' +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' +' Dim zeile As Integer +' +' ''''''''''''' Tabellenkopf +' Printer.CurrentY = Printer.CurrentY + 3 +' +'''''''''''''''''''''''''''' +' +' +' +' +' dblY = Printer.CurrentY +' +' Printer.Font.Bold = True +' +' For i = 0 To MSFlexGrid1.Cols - 1 +' MSFlexGrid1.row = 0 +' MSFlexGrid1.Col = i +' Printer.CurrentY = dblY +' Printer.CurrentX = Tabs(i) +' +' Select Case i +' Case 0 +' strTemp = "Vers." +' Case 1 +' strTemp = "AuftragNr/Pos" +' Case 12 +' strTemp = "Anz." +' Case 15 +' strTemp = "" +' Case Else +' strTemp = MSFlexGrid1.Text +' +' End Select +' +' Select Case i +' Case 1, 2, 3, 5, 6 +' Printer.CurrentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 +' End Select +' +' +' Printer.Print strTemp +' Next +' +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' +''''''''''''''''''''''''''''# +' ' Obere Kante der Tabelle merken +' dblY = Printer.CurrentY + 8 +' ZeileAufBlatt = 0 +' +' ' Spalten Linien +' 'For i = 0 To 13 +' ' Printer.Line (Tabs(i), dblY)-(Tabs(i), 270) +' 'Next +' +' Printer.CurrentY = dblY - 8 +' +' For zeile = 1 To mlngRecordsFound +' ZeileAufBlatt = ZeileAufBlatt + 1 +' If Printer.CurrentY > 270 Then +' ' Zeile passt nicht mehr aufs Blatt +' +' ZeileAufBlatt = 1 +' Call SeitenFuss(strAusblenden, Seite) +' +' Printer.NewPage +' Printer.Font.Size = SCHRIFTTABELLE +' +' Seite = Seite + 1 +' StatusBar1.SimpleText = "Drucke Seite " & Seite +' DoEvents +' +' Printer.CurrentY = 5 +' Call Tabellenkopf +' ' Obere Kante der Tabelle +' dblY = Printer.CurrentY + 8 +' End If +' +' Printer.CurrentY = dblY +' +' For i = 0 To MSFlexGrid1.Cols - 1 +' Printer.CurrentY = dblY + (ZeileAufBlatt - 2) * 5 +' MSFlexGrid1.row = zeile +' MSFlexGrid1.Col = i +' strTemp = Trim(MSFlexGrid1.Text) +' Printer.Font.Size = 8 +' Printer.Font.Bold = False +' Select Case i +' Case 0 +' 'Versanddatum +' strTemp = Format(CDate(strTemp), "dd.mm") +' Case 1 +' ' AuftragNr/Pos +' Case 2 +' 'IdentNr +' Case 3 +' 'Menge +' Case 4 +' ' Bezeichnung +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 5, 6 ' SerienNr Von Bis +' ' Printer.Font.Size = 8 +' Case 7 ' Anzeige +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 8 ' Bemerkung +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Case 9 ' ZusatzText +' Printer.Font.Size = 6 +' strTemp = Textformat(strTemp, i) +' Printer.CurrentY = Printer.CurrentY + 1 +' End Select +' +' Printer.CurrentX = Tabs(i) +' +' Select Case i +' Case 0, 1, 2, 3, 5, 6 +' ' rechtsbündig +' Printer.CurrentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 2 +' End Select +' +' ' Drucken +' Select Case i +' Case 8 +' ' Bemerkung +' Printer.CurrentY = Printer.CurrentY - 1 +' Printer.CurrentX = Tabs(i) +' Printer.Print Left(strTemp, 10) +' Printer.CurrentX = Tabs(i) +' Printer.Print Mid(strTemp, 11) +' Case 9 +' ' Bemerkung +' Printer.CurrentY = Printer.CurrentY - 2 +' Printer.CurrentX = Tabs(i) +' Printer.Print Left(strTemp, 10) +' Printer.CurrentX = Tabs(i) +' Printer.Print Mid(strTemp, 11) +' Case Else +' Printer.Print strTemp +' End Select +' +' dblLastFontSize = Printer.Font.Size +' Printer.Font.Size = 8 +' Next +' +' ' da letzte Spalte eine kleinere Schriftgroesse haben könnte +' 'Printer.CurrentY = Printer.CurrentY + 2 +' Printer.DrawWidth = 3 +' +' If zeile < mlngRecordsFound Then +' If strAusblenden <> "VF" Then +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' Else +' If MSFlexGrid1.Cols > 14 Then +' ' es gibt Spalte Linie +' strLinie = MSFlexGrid1.TextMatrix(zeile + 1, 14) +' If zeile > 1 Then +' strAlteLinie = MSFlexGrid1.TextMatrix(zeile, 14) +' Else +' strAlteLinie = strLinie +' End If +' +' If strAlteLinie <> strLinie Then +' Printer.DrawStyle = vbSolid +' lngFarbe = RGB(0, 0, 0) +' Else +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' End If +' Else +' Printer.DrawStyle = vbDashDot +' lngFarbe = RGB(224, 224, 224) +' End If +' End If +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY), lngFarbe +' Else +' Printer.DrawStyle = vbSolid +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 2 +' Printer.Font.Bold = True +' strTemp = "Summe " & lngSummeMenge +' Printer.CurrentX = Tabs(3 + 1) - Printer.TextWidth(strTemp) - 2 +' Printer.Print strTemp +' End If +' +' +' DoEvents +' If m_blnAbbruch Then +' Call Abbruch +' Exit Sub +' End If +' Next +' +' Printer.CurrentY = Printer.CurrentY + 3 +' If Printer.CurrentY < 278 Then +' Printer.Line (0, Printer.CurrentY)-(Tabs(15), Printer.CurrentY) +' Printer.Line (0, Printer.CurrentY + 1)-(Tabs(15), Printer.CurrentY + 1) +' End If +' +' SeitenFuss strAusblenden, Seite, " von " & Seite & " Seiten" +' If m_blnAbbruch Then +' cmdAbbruch.Enabled = False +' Call Abbruch +' Exit Sub +' End If +' +' Printer.EndDoc +' MsgBox "Die Liste wurde gedruckt!" +' End If + + + +Private Sub AuftragsInfoAnzeigen() + Dim strSql As String + Dim rs As CRecordset + Dim strTemp As String + Dim ZeileAufBlatt As Integer + Dim dblY As Double + Dim objVako As CVakoCode + Dim strVako As String + + Dim Seite As Integer + + Dim i As Integer + Dim lngSummeMenge As Long + Dim lngSummeGeprueft As Long + + Dim dblLastFontSize As Double + + StatusBar1.SimpleText = "" + labelGefertigtMenge.Caption = "0" + labelOffenWert.Caption = "0" + + m_blnIstAlleAuftraege = False + mlngRecordsFound = 0 + m_blnAbbruch = False + cmdAbbruch.Enabled = True + cmdExcel.Enabled = False + + Screen.MousePointer = vbHourglass + DoEvents + + + MSFlexGrid1.Rows = 1 + MSFlexGrid1.ScrollBars = flexScrollBarBoth + + MSFlexGrid1.Font = "Courier New" + MSFlexGrid1.Font.Size = 8 + MSFlexGrid1.cols = 1 + + If lstAPOrt.text = TEXTALLELINIEN Or lstAPOrt.text = TEXTALLELINIEN_OHNE_VS Or lstAPOrt.SelCount > 1 Then + ' mehr als ein Ort + MSFlexGrid1.FormatString = " Fert.Dat |Position|IdentNr |Menge| Bezeichnung | Bohrung |MID|L|A|V|E|M|P|R|D| Anzeige | Bemerkung | Status|Fert.Auftr.Nr|Ort" + Else + 'genau ein Ort + MSFlexGrid1.FormatString = " Fert.Dat |Position|IdentNr |Menge| Bezeichnung | Bohrung |MID|L|A|V|E|M|P|R|D| Anzeige | Bemerkung | Status|Fert.Auftr.Nr" + End If + + 'If cmbAPOrt.Text = TEXTALLELINIEN Then + ' MSFlexGrid1.FormatString = MSFlexGrid1.FormatString & "|L " + 'End If + + strSql = "SELECT AlleAuftragPositionen.AuftragNr, AlleAuftragPositionen.PositionNr, AlleAuftragPositionen.IdentNr, AlleAuftragPositionen.VersandDatum, AlleAuftragPositionen.TLMenge_P, " + strSql = strSql & " AlleAuftragPositionen.Menge, AlleAuftragPositionen.Metrolog, AlleAuftragPositionen.TLMenge, AlleAuftragPositionen.Bohrung, AlleAuftragPositionen.Farbe, AlleAuftragPositionen.Anzeige, AlleAuftragPositionen.L_IstTermin, AlleAuftragPositionen.A_IstTermin, AlleAuftragPositionen.V_IstTermin, AlleAuftragPositionen.E_IstTermin, AlleAuftragPositionen.ZusatzText, AlleAuftragPositionen.Prf_nach_MID, " + strSql = strSql & " AlleAuftragPositionen.M_IstTermin, AlleAuftragPositionen.P_IstTermin, AlleAuftragPositionen.R_IstTermin, AlleAuftragPositionen.Bem_Fertigung, AlleAuftragPositionen.Ort, AlleAuftragPositionen.Bestellcode, " + strSql = strSql & " AlleAuftragPositionen.Bezeichnung , IdentNr.KurzBez, IdentNr.Typ, IdentNr.Typzusatz, IdentNr.Nennweite, IdentNr.Temperatur, IdentNr.Druck, IdentNr.Baulaenge, IdentNr.Bestellgruppe, IdentNr.SAP_Nummer, IdentNr.IdentNrString, AlleAuftragPositionen.Kennzeichen2, " + strSql = strSql & " Herkunft, AlleAuftragPositionen.KundenNr, Kunde.Ort as Kundenort, Kunde.Name as KundenName, AlleAuftragPositionen.FertigungsauftragNr, IdentNr.Fert_Ort, IdentNr.VakoCode " + strSql = strSql & " FROM AlleAuftragPositionen " & vbCrLf + + strSql = strSql & " INNER JOIN Identnr ON AlleAuftragPositionen.IdentNr = Identnr.IdentNr " + strSql = strSql & " INNER JOIN Kunde ON AlleAuftragPositionen.KundenNr = Kunde.KundenNr " & vbCrLf + + 'strSQL = strSQL & " WHERE (AlleAuftragPositionen.VersandDatum >= CONVERT(DATETIME, '" & Format(DTPickerVon.Value, "yyyy-mm-dd") & " 00:00:00', 102)) AND " + 'strSQL = strSQL & " (AlleAuftragPositionen.VersandDatum <= CONVERT(DATETIME, '" & Format(DTPickerBis.Value, "yyyy-mm-dd") & " 23:59:59', 102))" + + strSql = strSql & " WHERE AlleAuftragPositionen.AuftragNr = " & Val(txtFilterAuftrag.text) & " " + strSql = strSql & " OR AlleAuftragPositionen.FertigungsauftragNr = " & Val(txtFilterAuftrag.text) & " " + strSql = strSql & " OR AlleAuftragPositionen.Lead_AufNr = " & Val(txtFilterAuftrag.text) & " " + + + strSql = strSql & vbCrLf + strSql = strSql & " ORDER BY PositionNr, Herkunft" + + Debug.Print strSql + + Set rs = New CRecordset + rs.openRS strSql, True + Set m_rs = rs + + MSFlexGrid1.Rows = 2 + mlngRecordsFound = 0 + lngSummeMenge = 0 + + mlngRecordsFound = 0 + If Not rs.EOF Then + + If Trim(txtFilterAuftrag.text) <> Trim(CStr(rs.getLongValue("AuftragNr"))) Then + StatusBar1.SimpleText = "FertigungsauftragNr " & txtFilterAuftrag.text & " = AuftragNr " & CStr(rs.getLongValue("AuftragNr")) & " " + + txtFilterAuftrag.text = CStr(rs.getLongValue("AuftragNr")) + cmdAuftragInfo.ToolTipText = "Informationen zu dieser AuftragNr in der Liste anzeigen" + End If + + Do While Not rs.EOF + '''''''''''''''''''''''' Vakocode auswerten ''''''''''''''''''''''' + Set objVako = Nothing + strVako = Trim(rs.getStringValue("VakoCode")) + If Len(strVako) > 0 Then + Set objVako = New CVakoCode + objVako.Load strVako + Debug.Print objVako.mstrDebug + End If + '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + + + cmdExcel.Enabled = True + + mlngRecordsFound = mlngRecordsFound + 1 + MSFlexGrid1.row = MSFlexGrid1.Rows - 1 + + MSFlexGrid1.col = 0 + MSFlexGrid1.text = Format(rs.getLongValue("Versanddatum"), "dd.mm.yyyy") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = rs.getLongValue("PositionNr") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = getIdentNrTextFromRecordset(rs, "") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + If rs.getStringValue("Herkunft") = "AuftragPosition" Then + If rs.getLongValue("TLMenge") = 0 Then + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") + MSFlexGrid1.text = rs.getLongValue("Menge") + labelOffenWert.Caption = Val(labelOffenWert.Caption) + rs.getLongValue("Menge") + Else + labelOffenWert.Caption = Val(labelOffenWert.Caption) + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + MSFlexGrid1.text = "R " & rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + End If + Else + labelGefertigtMenge.Caption = Val(labelGefertigtMenge.Caption) + rs.getLongValue("TLMenge") + MSFlexGrid1.text = rs.getLongValue("TLMenge") + lngSummeMenge = lngSummeMenge + rs.getLongValue("TLMenge") + End If + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + + MSFlexGrid1.ColAlignment(4) = flexAlignLeftCenter + ' If InStr(1, UCase(rs.getStringValue("ZusatzText")), UCase("MS Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' ElseIf InStr(1, UCase(rs.getStringValue("Typ")), UCase("MeiStream Plus")) > 0 Then + ' MSFlexGrid1.Text = "+" & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' Else + MSFlexGrid1.text = IIf((Left(rs.getStringValue("Bezeichnung"), 3) = "CKD"), "CKD ", "") & rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' MSFlexGrid1.Text = rs.getStringValue("KurzBez") & " " & Trim(rs.getStringValue("Typ") & " " & rs.getStringValue("TypZusatz")) & " " & CStr(rs.getIntValue("Nennweite")) & " " & CStr(rs.getLongValue("Temperatur")) & "°C PN" & rs.getIntValue("Druck") + ' End If + + If Not rs.isFieldNull("Baulaenge") Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & rs.getLongValue("Baulaenge") + Else + 'Baulänge evtl über Bestellcode bestimmen + strTemp = GetBaulaengeFromAuftragposition(Val(txtFilterAuftrag.text), rs.getLongValue("PositionNr"), rs.getLongValue("Bestellgruppe")) + If strTemp <> "" Then + MSFlexGrid1.text = MSFlexGrid1.text & " L" & strTemp + End If + End If + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = Replace(rs.getStringValue("Bohrung"), "Bohrbild", "") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.getLongValue("Prf_nach_MID") = 0, "", "MID") + + ' neu RH 15.3.2012 + If rs.getStringValue("Metrolog") = "MID" Then + MSFlexGrid1.text = "MID" + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("L_IstTermin"), "", "L") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("A_IstTermin"), "", "A") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("V_IstTermin"), "", "V") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("E_IstTermin"), "", "E") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("M_IstTermin"), "", "M") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("P_IstTermin"), "", "P") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = IIf(rs.isFieldNull("R_IstTermin"), "", "R") + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + + Dim lngAuftragsMenge As Long + Dim lngAnzahlDruckprf As Long + lngAnzahlDruckprf = AnzahlDruckGepruefterZaehler(rs.getLongValue("AuftragNr"), rs.getLongValue("PositionNr")) + lngAuftragsMenge = rs.getLongValue("Menge") + + If lngAnzahlDruckprf >= lngAuftragsMenge Then + If lngAnzahlDruckprf = lngAuftragsMenge Then + MSFlexGrid1.text = "D" + Else + MSFlexGrid1.text = "d" + End If + End If + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = Trim(rs.getStringValue("Anzeige")) + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "eRegister") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " E" + End If + End If + + If Not objVako Is Nothing Then + If InStr(1, objVako.GetWert("Zählwerk"), "Encoder") > 0 Then + MSFlexGrid1.text = MSFlexGrid1.text & " Enc" + End If + End If + + ' Bemerkung + MSFlexGrid1.col = MSFlexGrid1.col + 1 + +' If Not rs.isFieldNull("P_IstTermin") Then +' MSFlexGrid1.Text = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") +' Else +' If Not rs.isFieldNull("R_IstTermin") Then +' MSFlexGrid1.Text = "R:" & Format(rs.getDateValue("R_IstTermin"), "dd.mm") +' End If +' End If +' +' MSFlexGrid1.Text = Trim(MSFlexGrid1.Text & " " & rs.getStringValue("Bem_Fertigung")) +' +' ' neu RH 12.06.2007 Für Ort ZY soll die Farbe angezeigt werden, da die Temperatur = NULL ist +' If rs.getStringValue("Ort") = "ZY" And rs.getStringValue("Farbe") <> "" Then +' If MSFlexGrid1.Text <> "" Then MSFlexGrid1.Text = MSFlexGrid1.Text & "," +' MSFlexGrid1.Text = MSFlexGrid1.Text & rs.getStringValue("Farbe") +' End If + + MSFlexGrid1.text = GetBemerkungText(rs, lngSummeGeprueft) + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + If rs.getStringValue("Herkunft") = "AuftragPosition" Then + MSFlexGrid1.text = "offen" + Else + MSFlexGrid1.text = "fertig" + End If + + + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = Trim(rs.getLongValue("FertigungsAuftragNr")) + + If lstAPOrt.text = TEXTALLELINIEN Or lstAPOrt.text = TEXTALLELINIEN_OHNE_VS Or lstAPOrt.SelCount > 1 Then + ' mehr als ein Ort ,also Ort angeben + MSFlexGrid1.col = MSFlexGrid1.col + 1 + MSFlexGrid1.text = Trim(rs.getStringValue("Ort")) + End If + + rs.MoveNext + + If Not rs.EOF Then + MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1 + End If + + DoEvents + + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + Loop + SetSpalteNameZuordnung + + If InStr(1, StatusBar1.SimpleText, "FertigungsauftragNr") = 0 Then + ' Anzahl der Positionen nur anzeigen, wenn eine AuftragNr eingegeben wurde + ' Wenn eine FertigungsAuftragNr eingegeben wurde, + ' wird sowieso nur eine Zeile angezeigt + StatusBar1.SimpleText = MSFlexGrid1.Rows - 1 & " Positionen" + End If + Else + StatusBar1.SimpleText = "keine passenden Datensätze" + End If + + lblGeprueft.Caption = lngSummeGeprueft + + lblSumme.Caption = lngSummeMenge + Set m_rs = rs + +' If ChkDrucker.Value = vbChecked And mlngRecordsFound > 0 Then +' Printer.ColorMode = 2 +' Printer.Copies = Val(cmbAnzahlKopien.Text) +' +' Printer.Font = "Arial" +' Printer.ScaleMode = vbMillimeters +' +' Printer.ScaleLeft = -4 ' Rand +' Printer.ScaleTop = -1 ' Rand +' +' '''''''''''''''''Seiten Kopf +' Seite = 1 +' Printer.CurrentY = 5 +' Printer.Line (0, Int(Printer.CurrentY))-(TabsAuftr(15), Int(Printer.CurrentY)) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY) +' +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.CurrentX = 5 +' Printer.Font.Size = 15 +' Printer.Font.Bold = True +' +' +' Printer.FontTransparent = True +' dblY = Printer.CurrentY +' Printer.Print "Informationen zu Auftrag " & Val(txtFilterAuftrag.Text) +' Printer.Font.Size = SCHRIFTTABELLE +' Printer.Font.Bold = False +' +' rs.MoveFirst +' Printer.CurrentX = 10 +' Printer.Print "Kunde " & rs.getStringValue("KundenName") & "," & rs.getStringValue("Kundenort") & ", KndNr: " & rs.getLongValue("KundenNr") +' +' Printer.CurrentY = dblY +' Printer.CurrentX = 130 +' Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") +' +' Printer.CurrentY = Printer.CurrentY + 15 - SCHRIFTTABELLE +' Printer.CurrentY = Printer.CurrentY + 1 +' +' Printer.CurrentX = 10 +' strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") +' Printer.Print strTemp +' +' Printer.CurrentY = Printer.CurrentY + 3 +' +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 1 +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY) +' +' Dim zeile As Integer +' +' ''''''''''''' Tabellenkopf +' Printer.CurrentY = Printer.CurrentY + 3 +' Call TabellenkopfAlleAuftr +' +' ' Obere Kante der Tabelle merken +' dblY = Printer.CurrentY + 8 +' ZeileAufBlatt = 0 +' +' ' Spalten Linien +'' For i = 0 To 13 +'' Printer.Line (TabsAuftr(i), dblY)-(TabsAuftr(i), 270) +'' Next +' +' Printer.CurrentY = dblY - 8 +' +' +' For zeile = 1 To mlngRecordsFound +' ZeileAufBlatt = ZeileAufBlatt + 1 +' +' If Printer.CurrentY > 270 Then +' ' Zeile passt nicht mehr aufs Blatt +' +' ZeileAufBlatt = 1 +' Call SeitenFussAlleAuftr(Seite) +' +' Printer.NewPage +' Printer.Font.Size = SCHRIFTTABELLE +' +' Seite = Seite + 1 +' StatusBar1.SimpleText = "Drucke Seite " & Seite +' DoEvents +' +' Printer.CurrentY = 5 +' Call TabellenkopfAlleAuftr +' ' Obere Kante der Tabelle +' dblY = Printer.CurrentY + 8 +' End If +' +' Printer.CurrentY = dblY +' +' For i = 0 To MSFlexGrid1.Cols - 1 +' Printer.CurrentY = dblY + (ZeileAufBlatt - 2) * 5 +' MSFlexGrid1.row = zeile +' MSFlexGrid1.Col = i +' strTemp = Trim(MSFlexGrid1.Text) +' Printer.Font.Size = 8 +' Printer.Font.Bold = False +' Select Case i +' Case 0 +' 'Versanddatum +' Printer.Font.Bold = True +' strTemp = Format(CDate(strTemp), "dd.mm") +' Case 1 +' ' Pos +' Printer.Font.Bold = True +' Case 2 +' 'IdentNr +' Printer.Font.Bold = True +' Case 3 +' 'Menge +' Printer.Font.Bold = True +' Case 4 +' ' Bezeichnung +' Printer.Font.Size = 6 +' strTemp = TextformatAuftragInfo(strTemp, i) +' Case 5 +' ' Bohrung +' strTemp = TextformatAuftragInfo(strTemp, i) +' Printer.Font.Size = 6 +' Case 6, 7, 8, 9, 10 'AVMPR +' Printer.Font.Bold = True +' Case 12 ' Anzeige +' Printer.Font.Size = 6 +' strTemp = TextformatAuftragInfo(strTemp, i) +' Case 12 ' Bemerkung +' Printer.Font.Size = 6 +' strTemp = TextformatAuftragInfo(strTemp, i) +' Case 13 ' Status +' strTemp = TextformatAuftragInfo(strTemp, i) +' If strTemp = "offen" Then +' Printer.Font.Size = 8 +' Printer.Font.Bold = True +' Else +' Printer.Font.Size = 6 +' Printer.Font.Bold = False +' End If +' End Select +' +' Printer.CurrentX = TabsAuftr(i) +' +' Select Case i +' Case 1, 2, 3 +' ' rechtsbündig +' ' Position, IdentNr, Menge +' Printer.CurrentX = TabsAuftr(i + 1) - Printer.TextWidth(strTemp) - 1 +' Case 0 +' ' rechtsbündig +' ' Versanddatum, Be +' Printer.CurrentX = TabsAuftr(i + 1) - Printer.TextWidth(strTemp) - 2 +' End Select +' +' Select Case i +' Case 12 +' ' Bemerkung +' Printer.CurrentY = Printer.CurrentY - 2 +' Printer.CurrentX = TabsAuftr(i) +' Printer.Print Left(strTemp, 10) +' Printer.CurrentX = TabsAuftr(i) +' Printer.Print Mid(strTemp, 11) +' Printer.CurrentY = Printer.CurrentY + 1 +' Case Else +' Printer.Print strTemp +' End Select +' +' dblLastFontSize = Printer.Font.Size +' Printer.Font.Size = 8 +' Next +' +' ' da letzte Spalte eine kleinere Schriftgroesse haben könnte +' Printer.CurrentY = Printer.CurrentY + 1 +' +' Printer.DrawWidth = 3 +' +' If zeile < mlngRecordsFound Then +' Printer.DrawStyle = vbDashDot +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY), RGB(224, 224, 224) +' Else +' Printer.DrawStyle = vbSolid +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY) +' Printer.CurrentY = Printer.CurrentY + 2 +' Printer.Font.Bold = True +' dblY = Printer.CurrentY +' strTemp = "Summe " & lngSummeMenge +' Printer.CurrentX = TabsAuftr(3 + 1) - Printer.TextWidth(strTemp) - 1 +' Printer.Print strTemp +' +' Printer.CurrentY = dblY +' strTemp = "offen: " & Val(labelOffenWert.Caption) & ", gefertigt: " & Val(labelGefertigtMenge.Caption) +' Printer.CurrentX = TabsAuftr(5) +' Printer.Print strTemp +' End If +' +' +' DoEvents +' If m_blnAbbruch Then +' Call Abbruch +' Exit Sub +' End If +' Next +' +' Printer.CurrentY = Printer.CurrentY + 3 +' If Printer.CurrentY < 278 Then +' Printer.Line (0, Printer.CurrentY)-(TabsAuftr(15), Printer.CurrentY) +' Printer.Line (0, Printer.CurrentY + 1)-(TabsAuftr(15), Printer.CurrentY + 1) +' End If +' +' SeitenFussAlleAuftr Seite, " von " & Seite & " Seiten" +' If m_blnAbbruch Then +' Call Abbruch +' cmdAbbruch.Enabled = False +' Exit Sub +' End If +' +' Printer.EndDoc +' MsgBox "Die Liste wurde gedruckt!" +' End If + If chkSpaltenbreiteAnpassen.Value = vbChecked Then + AutoSpaltenBreite MSFlexGrid1, lblAutosize + End If + + cmdAbbruch.Enabled = False + Me.Enabled = True + Screen.MousePointer = vbNormal +End Sub + + +Private Sub Abbruch() + Printer.KillDoc + Me.Enabled = True + Screen.MousePointer = vbNormal +End Sub + +Private Sub Tabellenkopf() + Dim i As Integer + Dim dblY As Double + Dim strTemp As String + + dblY = Printer.currentY + + Printer.Font.Bold = True + + + For i = 0 To MSFlexGrid1.cols - 1 + + + Printer.Font.Size = 8 + + MSFlexGrid1.row = 0 + MSFlexGrid1.col = i + Printer.currentY = dblY + Printer.currentX = Tabs(i) + strTemp = "" + Select Case i + Case 0 + strTemp = "Fert." + Case 1 + strTemp = "Auftrag/Pos" + Case 7 + 'strTemp = "Info" + If chkSonderlayoutFertigung.Value = vbChecked Then + strTemp = "Knd Sernr von - bis" + Printer.Font.Size = 8 + Else + Printer.Font.Size = 5 + End If + Case 8 + If chkSonderlayoutFertigung.Value = vbChecked Then + strTemp = "FA-Nr" + Printer.Font.Size = 8 + Else + Printer.Font.Size = 5 + End If + Case 9, 10, 11, 12, 13, 14 + Printer.Font.Size = 5 + If chkSonderlayoutFertigung.Value = vbChecked Then + Printer.Font.Size = 8 + strTemp = MSFlexGrid1.text + End If + Case 15 + Printer.Font.Size = 5 + Case 16 + strTemp = "Anz." + Case Else + strTemp = MSFlexGrid1.text + End Select + + Select Case i + Case 0, 1, 3, 4 + Printer.currentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 + End Select + + Debug.Print i & ":" & MSFlexGrid1.text + Printer.Print strTemp + Next + Printer.Font.Size = 8 + + Printer.Print "" + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) +End Sub + + +Private Sub TabellenkopfAlleAuftr() + Dim i As Integer + Dim dblY As Double + Dim strTemp As String + + dblY = Printer.currentY + + Printer.Font.Bold = True + + For i = 0 To MSFlexGrid1.cols - 1 + MSFlexGrid1.row = 0 + MSFlexGrid1.col = i + Printer.currentY = dblY + Printer.currentX = TabsAuftr(i) + + Printer.Font.Size = 8 + strTemp = MSFlexGrid1.text + + Select Case i + Case 0 + strTemp = "Fert." + Case 1 + strTemp = "Pos." + Case 6, 7, 8, 9, 10, 11, 12, 13, 14 + Printer.Font.Size = 6 + Case 15 + strTemp = "Anz." + Case 18 + strTemp = "FA-Nr" + End Select + +' Select Case i +' Case 1, 3, 4 +' Printer.CurrentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 +' End Select + + Debug.Print i & " " & MSFlexGrid1.text & " =" & strTemp & " " & TabsAuftr(i) + Printer.Print strTemp + Next + + Printer.Line (0, Printer.currentY)-(Tabs(19), Printer.currentY) +End Sub + + +Private Sub SeitenFuss(strAusblenden As String, Seite As Integer, Optional strText As String = "") + Printer.Font.Size = 6 + Printer.currentX = 0 + Printer.currentY = Printer.ScaleHeight - 2 * Printer.TextHeight("X") - 3 + Printer.Font.Bold = False + Printer.Print "Legende: *:Modul" + + Printer.Print GetUeberschrift(strAusblenden) & ", Fert.-Ort: " & GetFertOrtText() & ", gedruckt am " & Format(Now(), "dd.mm.yyyy hh:mm:ss") & " von " & Mid(g_App.getMitarbeiter.getVorname, 1, 1) & ". " & g_App.getMitarbeiter.getName & " Seite " & Seite & " " & strText +End Sub + + +Private Function GetFertOrtText() As String + Dim i As Integer + GetFertOrtText = "" + For i = 0 To lstAPOrt.ListCount - 1 + If lstAPOrt.Selected(i) Then + GetFertOrtText = GetFertOrtText & lstAPOrt.List(i) & " " + End If + Next + GetFertOrtText = Trim(GetFertOrtText) +End Function + +Private Sub SeitenFussAlleAuftr(Seite As Integer, Optional strText As String = "") + Printer.Font.Size = 6 + Printer.currentX = 0 + Printer.currentY = Printer.ScaleHeight - Printer.TextHeight("X") - 3 + Printer.Font.Bold = False + Printer.Print "gedruckt am " & Format(Now(), "dd.mm.yyyy hh:mm:ss") & " von " & Mid(g_App.getMitarbeiter.getVorname, 1, 1) & ". " & g_App.getMitarbeiter.getName & " Seite " & Seite & " " & strText +End Sub + + + +Private Sub MSFlexGrid1_Click() + On Error GoTo Errorhandler + + Dim strText As String + + Dim lngAuftragNr As Long + Dim lngPositionNr As Long + Dim strSpaltenname As String + Dim strFeldname As String + + Dim strWert As String + + If MSFlexGrid1.row = 0 Then + ' Sortierung war schon + Exit Sub + End If + + If InStr(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, 1), "/") > 0 Then + lngAuftragNr = Val(Split(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, 1), "/")(0)) + lngPositionNr = Val(Split(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, 1), "/")(1)) + Else + lngAuftragNr = Val(txtFilterAuftrag.text) + lngPositionNr = Val(MSFlexGrid1.TextMatrix(MSFlexGrid1.row, 1)) + End If + + strSpaltenname = MSFlexGrid1.TextMatrix(0, MSFlexGrid1.col) + strWert = MSFlexGrid1.text + + Debug.Print "'" & MSFlexGrid1.text & "' Spalte " & MSFlexGrid1.col & ", Zeile " & MSFlexGrid1.row + + txtFilterKunde.text = "" + If MSFlexGrid1.col = 1 And MSFlexGrid1.row > 0 And m_blnIstAlleAuftraege = True Then + ' AuftragNr wurde angeklickt + If UBound(Split(MSFlexGrid1.text, "/")) > 0 Then + txtFilterAuftrag.text = Split(MSFlexGrid1.text, "/")(0) + Anzeigen m_strAusblenden + Exit Sub + End If + End If + + 'KundenOrt + If MSFlexGrid1.col = 2 And MSFlexGrid1.row > 0 And m_blnIstAlleAuftraege = True Then + txtFilterKunde.text = MSFlexGrid1.text + Anzeigen m_strAusblenden + Exit Sub + End If + + txtEingabe.Visible = False + + If chkVersuch.Value = vbUnchecked And strSpaltenname = "Bemerkung" And MSFlexGrid1.row > 0 And m_blnIstAlleAuftraege = True Then + m_intLastX = MSFlexGrid1.col + m_intLastY = MSFlexGrid1.row + + txtEingabe.MaxLength = 20 + txtEingabe.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(MSFlexGrid1.col) + 30 + txtEingabe.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(MSFlexGrid1.row) + 30 + txtEingabe.width = MSFlexGrid1.ColWidth(MSFlexGrid1.col) + 30 + txtEingabe.Height = MSFlexGrid1.RowHeight(MSFlexGrid1.row) + ' + ' feld aktueller wert zuweisen und focus setzen + ' + m_strLastText = MSFlexGrid1.text + txtEingabe.text = MSFlexGrid1.text + + txtEingabe.Visible = True + txtEingabe.ZOrder 0 + txtEingabe.SetFocus + Exit Sub + End If + + If m_blnIstAlleAuftraege = False And strSpaltenname = "Bemerkung" And MSFlexGrid1.row > 0 Then + m_intLastX = MSFlexGrid1.col + m_intLastY = MSFlexGrid1.row + + txtEingabe.MaxLength = 20 + txtEingabe.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(MSFlexGrid1.col) + 30 + txtEingabe.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(MSFlexGrid1.row) + 30 + txtEingabe.width = MSFlexGrid1.ColWidth(MSFlexGrid1.col) + 30 + txtEingabe.Height = MSFlexGrid1.RowHeight(MSFlexGrid1.row) + ' + ' feld aktueller wert zuweisen und focus setzen + ' + m_strLastText = MSFlexGrid1.text + txtEingabe.text = MSFlexGrid1.text + txtEingabe.Visible = True + txtEingabe.ZOrder 0 + txtEingabe.SetFocus + Exit Sub + End If + + If chkVersuch.Value = vbChecked And strSpaltenname = "Bemerkung" And MSFlexGrid1.row > 0 And m_blnIstAlleAuftraege = True Then + m_intLastX = MSFlexGrid1.col + m_intLastY = MSFlexGrid1.row + + txtEingabe.MaxLength = 20 + txtEingabe.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(MSFlexGrid1.col) + 30 + txtEingabe.Top = MSFlexGrid1.Top + MSFlexGrid1.RowPos(MSFlexGrid1.row) + 30 + txtEingabe.width = MSFlexGrid1.ColWidth(MSFlexGrid1.col) + 30 + txtEingabe.Height = MSFlexGrid1.RowHeight(MSFlexGrid1.row) + ' + ' feld aktueller wert zuweisen und focus setzen + ' + m_strLastText = MSFlexGrid1.text + txtEingabe.text = MSFlexGrid1.text + txtEingabe.Visible = True + txtEingabe.ZOrder 0 + txtEingabe.SetFocus + Exit Sub + End If + + If MSFlexGrid1.row > 0 Then + Select Case strSpaltenname + Case "A", "V", "E", "M", "P", "R" + strFeldname = strSpaltenname & "_IstTermin" + strText = MSFlexGrid1.text & " " & Format(GetWertFromFeld(lngAuftragNr, lngPositionNr, strFeldname), "dd.mm.yyyy") + Case Else + strText = MSFlexGrid1.text + End Select + Clipboard.SetText Replace(strText, "|", vbCrLf) + MsgBox strText, vbInformation, lngAuftragNr & "/" & lngPositionNr & " " & IIf(strFeldname = "", strSpaltenname, strFeldname) + + End If + + StatusBar1.SimpleText = "Spalte " & MSFlexGrid1.col & ": " & MSFlexGrid1.TextMatrix(0, MSFlexGrid1.col) + Exit Sub +Errorhandler: + MsgBox Err.Description +End Sub + + +Private Function GetWertFromFeld(lngAuftragNr As Long, lngPositionNr As Long, strFeldname As String) As String +On Error GoTo Errorhandler + + Dim strSql As String + Dim rs As CRecordset + + strSql = "SELECT " & strFeldname & " FROM AlleAuftragPositionen WHERE AuftragNr=" & lngAuftragNr & " AND PositionNr = " & lngPositionNr + Set rs = New CRecordset + rs.openRS strSql, True + If Not rs.EOF Then + GetWertFromFeld = rs.getStringValue(strFeldname) + Else + GetWertFromFeld = "" + End If +Exit Function +Errorhandler: + MsgBox "Fehler " & Err.Number & " in frmFertigungslisten.GetWertFromFeld(" & lngAuftragNr & "," & lngPositionNr & ",'" & strFeldname & "'): " & Err.Description + LogIntoDB "Fehler " & Err.Number & " in frmFertigungslisten.GetWertFromFeld(" & lngAuftragNr & "," & lngPositionNr & ",'" & strFeldname & "'): " & Err.Description, "Softwarefehler" +End Function + +Private Function GetUeberschrift(strAusblenden As String) As String + Select Case strAusblenden + Case "L" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Laserkennzeichnung)" + Case "A" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Auftragsbearbeitung)" + Case "V" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Vorfertigung)" + Case "E" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Messeinsatz montiert)" + Case "P" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Prüfen)" + Case "M" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Montage)" + Case "R" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Rechenwerk)" + Case "F" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Finish)" + Case "VF" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Versandfertig)" + Case "Sofort" + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Sofortaufträge)" + End Select + + If chkVersuch.Value = vbChecked Then + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Versuch)" + End If + + If chkSonderlayoutFertigung.Value = vbChecked Then + GetUeberschrift = "Sensus Auftragsverwaltung Liste (Fertigung)" + End If +End Function + + + + + + + + + +Private Sub txtEingabe_DblClick() + MsgBox txtEingabe.text +End Sub + +Private Sub txtEingabe_GotFocus() + cmdFinish.DEFAULT = False + MSFlexGrid1.ScrollBars = flexScrollBarNone + cmdPrint.Enabled = False +End Sub + +Private Sub txtEingabe_KeyPress(KeyAscii As Integer) + Debug.Print KeyAscii + Select Case KeyAscii + Case 13 + txtEingabe_LostFocus + End Select +End Sub + +Private Sub txtEingabe_LostFocus() + Dim strSpaltenname As String + + MSFlexGrid1.ScrollBars = flexScrollBarBoth + cmdPrint.Enabled = True + + strSpaltenname = MSFlexGrid1.TextMatrix(0, m_intLastX) + + + If m_intLastX > 0 And m_intLastY > 0 And txtEingabe.text <> m_strLastText Then + ' + ' wert im eingabefeld der letzten zelle zuweisen + ' + Debug.Print "zurückschreiben Y=" & m_intLastY & ", X=" & m_intLastX + MSFlexGrid1.TextMatrix(m_intLastY, m_intLastX) = txtEingabe.text + + If strSpaltenname = "Bemerkung" Then + Call SaveBemerkung(txtEingabe.text, m_intLastY) + End If + + +' Select Case m_intLastX +' Case 16 +' If chkVersuch.Value = vbUnchecked Then +' Call SaveBemerkung(txtEingabe.Text, m_intLastY) +' End If +' Case 8 +' If chkVersuch.Value = vbChecked Then +' Call SaveBemerkung(txtEingabe.Text, m_intLastY) +' End If +' Case 13 +' If m_blnIstAlleAuftraege = False Then +' Call SaveBemerkung(txtEingabe.Text, m_intLastY) +' End If +' End Select + + + End If + ' eingabefeld unsichtbar + ' + txtEingabe.Visible = False +End Sub + +Private Sub txtFilterAuftrag_Change() + cmdAuftragInfo.ToolTipText = "Informationen zu dieser AuftragNr bzw. FertigungsauftragNr in der Liste anzeigen" + + If txtFilterAuftrag.text = "" Then + cmdAuftragInfo.Enabled = False + cmdAuftragNrClear.Enabled = False + Else + cmdAuftragNrClear.Enabled = True + cmdAuftragInfo.DEFAULT = True + cmdAuftragInfo.Enabled = True + End If +End Sub + +Private Sub txtFilterAuftrag_Click() + txtFilterAuftrag.SelStart = 0 + txtFilterAuftrag.SelLength = Len(txtFilterAuftrag.text) + txtFilterAuftrag.SetFocus +End Sub + +Private Sub txtFilterAuftrag_KeyPress(KeyAscii As Integer) + Debug.Print KeyAscii + If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii > 32 Then + KeyAscii = 0 + End If +End Sub + + +Private Function Textformat(strText As String, Stelle As Integer) As String + On Error GoTo Errorhandler + Do While Printer.TextWidth(strText) >= (Tabs(Stelle + 1) - 1 - Tabs(Stelle)) + If Len(strText) > 0 Then + strText = Left(strText, Len(strText) - 1) + Else + Exit Do + End If + Loop + Textformat = strText +Exit Function + +Errorhandler: + Debug.Print Err.Number & " " & Err.Description + strText = Left(strText, 100) + Resume + +End Function + + +Private Function TextformatAuftragInfo(strText As String, Stelle As Integer) As String + Debug.Print "Vorher: " & strText & " ,Stelle=" & Stelle + Do While Printer.TextWidth(strText) >= (TabsAuftr(Stelle + 1) - 1 - TabsAuftr(Stelle)) + If Len(strText) > 0 Then + strText = Left(strText, Len(strText) - 1) + Else + Exit Do + End If + Loop + TextformatAuftragInfo = strText + Debug.Print "nachher:" & strText +End Function + +Private Sub AktualisiereComboBaulaenge() + Dim strFilter As String + Dim strText As String + Dim strTemp As String + + strText = cmbFilterBaulaenge.text + + cmbFilterBaulaenge.Clear + cmbFilterBaulaenge.AddItem TEXTALLE + cmbFilterBaulaenge.ListIndex = 0 + + + strFilter = GetFilterForTyp() +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strFilter = strFilter & "Fert_Ort <> 'VS' " +' Else +' strFilter = strFilter & "Fert_Ort ='" & cmbAPOrt.Text & "' " +' End If +' End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strTemp = GetFilterForTyp() + If strTemp <> "" Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & strTemp + End If + End If + + + + If cmbFilterNennweite.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Nennweite='" & Val(cmbFilterNennweite.text) & "'" + End If + + If cmbFilterTemp.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Temperatur='" & Val(cmbFilterTemp.text) & "'" + End If + + + FillCombo cmbFilterBaulaenge, "Baulaenge", strFilter + If strText <> "" Then + cmbFilterBaulaenge.text = strText + End If + + AktualisiereComboBohrbild +End Sub + + +Private Sub AktualisiereComboTyp() + Dim strFilter As String + + Me.MousePointer = vbHourglass + + lstFilterTyp.Clear + lstFilterTyp.AddItem TEXTALLETYPEN + lstFilterTyp.Selected(0) = True + + 'lstFilterTyp.ListIndex = 0 + strFilter = GetFilterOrt() + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strFilter = "Fert_Ort <> 'VS' AND " +' Else +' strFilter = "Fert_Ort ='" & cmbAPOrt.Text & "' AND " +' End If +' End If +' If chkVersuch.Value = vbUnchecked Then +' strFilter = strFilter & " Pruefklasse.FuerProduktion = 1 AND " +' End If + + strFilter = strFilter & "((KurzBez = N'WZ') OR (KurzBez = N'ME') OR (KurzBez = N'GE') or (KurzBez = N'FK') ) AND Typ <> '#' AND Typ not like 'FUV%'" + + If lstAPOrt.Selected(1) Then + 'Bei Linie 2 + lstFilterTyp.AddItem TEXTPSEUNDPFL + End If + + FillCombo lstFilterTyp, "Typ", strFilter + + AktualisiereComboNennweite + + Me.MousePointer = vbNormal +End Sub + +Private Sub AktualisiereComboMetrolog() + Dim strText As String + Dim strTemp As String + Dim strFilter As String + Dim rs As CRecordset + Dim strSql As String + + cmbFilterMetrolog.Clear + cmbFilterMetrolog.AddItem TEXTALLE + cmbFilterMetrolog.ListIndex = 0 + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strTemp = GetFilterForTyp() + If strTemp <> "" Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & strTemp + End If + End If + + If strFilter <> "" Then + strSql = " SELECT DISTINCT Pruefpunkte.PruefklasseKZ FROM Pruefpunkte " + strSql = strSql & "INNER JOIN Identnr ON Pruefpunkte.IdentNr = Identnr.IdentNr " + strSql = strSql & "INNER JOIN Pruefklasse ON Pruefpunkte.PruefklasseKZ = Pruefklasse.PruefklasseKZ " + strSql = strSql & "WHERE " & strFilter + + If chkVersuch.Value = vbUnchecked Then + strSql = strSql & "AND Pruefklasse.FuerProduktion = 1 " + End If + + strSql = strSql & "ORDER BY Pruefpunkte.PruefklasseKZ " + + Set rs = New CRecordset + rs.openRS strSql, True + + Do While Not rs.EOF + cmbFilterMetrolog.AddItem rs.getStringValue("PruefklasseKZ") + rs.MoveNext + Loop + End If +End Sub + +Private Sub AktualisiereComboNennweite() + Dim strText As String + Dim strTemp As String + Dim strFilter As String + Dim rs As CRecordset + + + strText = cmbFilterNennweite.text + cmbFilterNennweite.Clear + cmbFilterNennweite.AddItem TEXTALLE + cmbFilterNennweite.ListIndex = 0 + + strFilter = GetFilterOrt() + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strFilter = strFilter & "Fert_Ort <> 'VS' " +' Else +' strFilter = strFilter & "Fert_Ort ='" & cmbAPOrt.Text & "' " +' End If +' Else +' cmbAPOrt.Text ist ungleich TEXTALLELINIEN +' End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strTemp = GetFilterForTyp() + If strTemp <> "" Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & strTemp + End If + End If + + + FillCombo cmbFilterNennweite, "Nennweite", strFilter + If strText <> "" Then + cmbFilterNennweite = strText + End If + + AktualisiereComboTemp + + +End Sub + +Private Sub AktualisiereComboDruck() + Dim strFilter As String + Dim rs As CRecordset + Dim strText As String + Dim strTemp As String + + strText = cmbFilterDruck.text + + cmbFilterDruck.Clear + cmbFilterDruck.AddItem TEXTALLE + cmbFilterDruck.ListIndex = 0 + + strFilter = GetFilterOrt() + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strFilter = strFilter & "Fert_Ort <>'VS' " +' Else +' strFilter = strFilter & "Fert_Ort ='" & cmbAPOrt.Text & "' " +' End If +' Else +' ' alle Linien +' End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strTemp = GetFilterForTyp() + If strTemp <> "" Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & strTemp + End If + End If + + + + If cmbFilterNennweite.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Nennweite='" & Val(cmbFilterNennweite.text) & "'" + End If + + If cmbFilterTemp.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Temperatur='" & Val(cmbFilterTemp.text) & "'" + End If + + FillCombo cmbFilterDruck, "Druck", strFilter + + AktualisiereComboBaulaenge + + If strText <> "" Then + cmbFilterDruck.text = strText + End If +End Sub + +Private Sub AktualisiereComboBohrbild() + Dim strSql As String + Dim rs As CRecordset + Dim strText As String + + strText = cmbFilterBohrbild.text + + cmbFilterBohrbild.Clear + cmbFilterBohrbild.AddItem TEXTALLE + cmbFilterBohrbild.ListIndex = 0 + + strSql = "SELECT DISTINCT Bohrung From AuftragPosition ORDER BY Bohrung" + Set rs = New CRecordset + rs.openRS strSql, True + Do While Not rs.EOF + If Len(rs.getStringValue("Bohrung")) > 0 Then + cmbFilterBohrbild.AddItem rs.getStringValue("Bohrung") + End If + rs.MoveNext + Loop + + If strText <> "" Then + cmbFilterBohrbild.text = strText + End If + +End Sub + + +Private Sub AktualisiereComboTemp() + Dim strText As String + Dim strTemp As String + Dim strFilter As String + Dim rs As CRecordset + + strText = cmbFilterTemp.text + cmbFilterTemp.Clear + cmbFilterTemp.AddItem TEXTALLE + cmbFilterTemp.ListIndex = 0 + + strFilter = GetFilterOrt() + +' If cmbAPOrt.Text <> TEXTALLELINIEN Then +' If cmbAPOrt.Text = TEXTALLELINIEN_OHNE_VS Then +' strFilter = strFilter & "Fert_Ort <>'VS' " +' Else +' strFilter = strFilter & "Fert_Ort ='" & cmbAPOrt.Text & "' " +' End If +' Else +' ' alle Linien +' End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + strTemp = GetFilterForTyp() + If strTemp <> "" Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & strTemp + End If + End If + + + If cmbFilterNennweite.text <> TEXTALLE Then + If strFilter <> "" Then + strFilter = strFilter & " AND " + End If + strFilter = strFilter & " Nennweite='" & Val(cmbFilterNennweite.text) & "'" + End If + + + FillCombo cmbFilterTemp, "Temperatur", strFilter + If strText <> "" Then + cmbFilterTemp.text = strText + End If + + AktualisiereComboDruck +End Sub + +Private Sub txtFilterKunde_GotFocus() + txtFilterKunde.SelStart = 0 + txtFilterKunde.SelLength = Len(txtFilterKunde.text) +End Sub + +Private Sub SaveBemerkung(strText As String, Zeile As Integer) + Dim lngAuftragNr As Long + Dim intPostitionNr As Integer + Dim strSql As String + Dim RecordsAffected As Integer + + + If m_blnIstAlleAuftraege = True Then + lngAuftragNr = Val(Split(MSFlexGrid1.TextMatrix(Zeile, 1), "/")(0)) + intPostitionNr = Val(Split(MSFlexGrid1.TextMatrix(Zeile, 1), "/")(1)) + Else + ' nur ein Bestimmter Aufgtrag + lngAuftragNr = Val(txtFilterAuftrag.text) + intPostitionNr = MSFlexGrid1.TextMatrix(Zeile, 1) + End If + + LogIntoDB "Bem_Fertigung '" & strText & "' gespeichert in " & lngAuftragNr & "/" & intPostitionNr & " von " & g_App.getMitarbeiter.getNr, "SensusAV Listendruck" + + If lngAuftragNr > 0 Then + strSql = "UPDATE AuftragPosition set Bem_Fertigung = '" & Replace(strText, "'", "''") & "' WHERE AuftragNr = " & lngAuftragNr & " AND PositionNr=" & intPostitionNr + Debug.Print strSql + + g_App.getDB.getConnection.Execute strSql, RecordsAffected + + If RecordsAffected = 1 Then + MsgBox "Bemerkung '" & strText & "' gespeichert in AuftragPosition " & lngAuftragNr & "/" & intPostitionNr & " [Bem_Fertigung]." + Else + MsgBox "Bemerkung '" & strText & "' gespeichert in AuftragPosition " & lngAuftragNr & "/" & intPostitionNr & " [Bem_Fertigung] in " & RecordsAffected & " Datensätzen." + LogIntoDB "Bemerkung gespeichert in AuftragPosition." & lngAuftragNr & "/" & intPostitionNr & ". Datensätze:" & RecordsAffected, "Datenfehler" + End If + Else + MsgBox "Fehler in SaveBememerkung. AuftragNr wurde nicht ermittelt." + End If +End Sub + +'Private Sub fillcmbOrt() +' Dim i As Integer +' +' cmbAPOrt.Clear +' +' cmbAPOrt.AddItem TEXTALLELINIEN +' cmbAPOrt.AddItem TEXTALLELINIEN_OHNE_VS +' +' cmbAPOrt.ListIndex = cmbAPOrt.ListCount - 1 +' +' If chkVersuch.Value = vbChecked Then +' cmbAPOrt.AddItem "VS" +' cmbAPOrt.ListIndex = cmbAPOrt.ListCount - 1 +' End If +' +' cmbAPOrt.AddItem "L1" +' cmbAPOrt.AddItem "L2" +' cmbAPOrt.AddItem "L3" +' cmbAPOrt.AddItem "L4" +' cmbAPOrt.AddItem "L5" +' cmbAPOrt.AddItem "L6" +' cmbAPOrt.AddItem "L7" +' +' cmbAPOrt.AddItem "ZY" +' +' For i = 0 To cmbAPOrt.ListCount - 1 +' If cmbAPOrt.List(i) = GetIniWert("Listendruck", "Ort", "") Then +' cmbAPOrt.ListIndex = i +' Exit For +' End If +' Next +'End Sub + +Private Sub fillLstAPOrt() + lstAPOrt.Clear + + lstAPOrt.AddItem TEXTALLELINIEN + + lstAPOrt.AddItem TEXTALLELINIEN_OHNE_VS + If chkVersuch.Value = vbUnchecked Then + lstAPOrt.Selected(lstAPOrt.ListCount - 1) = True + End If + + + lstAPOrt.AddItem "L1" '0 + lstAPOrt.AddItem "L2" '1 + lstAPOrt.AddItem "L3" '2 + lstAPOrt.AddItem "L4" '3 + lstAPOrt.AddItem "L5" '4 + lstAPOrt.AddItem "L6" '5 + lstAPOrt.AddItem "L7" '6 + lstAPOrt.AddItem "ZY" '7 + lstAPOrt.AddItem "EL" + + + lstAPOrt.AddItem "VS" '8 + If chkVersuch.Value = vbChecked Then + lstAPOrt.Selected(lstAPOrt.ListCount - 1) = True + End If + +End Sub + +Private Function GetFilterForTyp() As String +Dim i As Integer +For i = 0 To lstFilterTyp.ListCount - 1 + + If lstFilterTyp.Selected(i) = True Then + + If lstFilterTyp.List(i) = TEXTALLETYPEN Then + GetFilterForTyp = "" + Exit Function + End If + + If GetFilterForTyp = "" Then + GetFilterForTyp = " Identnr.Typ <> '#' AND (" + Else + GetFilterForTyp = GetFilterForTyp & " OR " + End If + + Select Case lstFilterTyp.List(i) + Case TEXTPSEUNDPFL + GetFilterForTyp = GetFilterForTyp & "IdentNr.Typ = 'PSE' or IdentNr.Typ = 'PFL'" + Case Else + GetFilterForTyp = GetFilterForTyp & "IdentNr.Typ = '" & Replace(lstFilterTyp.List(i), "'", "''") & "'" + End Select + End If +Next +If GetFilterForTyp <> "" Then GetFilterForTyp = GetFilterForTyp & ")" + +End Function + + + + +Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) + ' If this is not row 0, do nothing. + If MSFlexGrid1.MouseRow <> 0 Then Exit Sub + + ' Sort by the clicked column. + SortByColumn MSFlexGrid1.MouseCol +End Sub + + +' Sort by the indicated column. +Private Sub SortByColumn(ByVal sort_column As Integer) + Dim blnSortNumeric As Boolean + + ' Hide the FlexGrid. + MSFlexGrid1.Visible = False + MSFlexGrid1.Refresh + + ' Sort using the clicked column. + MSFlexGrid1.col = sort_column + MSFlexGrid1.ColSel = sort_column + MSFlexGrid1.row = 0 + MSFlexGrid1.RowSel = 0 + + Dim strSpalte As String + + strSpalte = MSFlexGrid1.TextMatrix(0, sort_column) + strSpalte = Replace(strSpalte, " ", "") + strSpalte = Replace(strSpalte, ">", "") + strSpalte = Replace(strSpalte, "<", "") + + Select Case strSpalte + Case "FA-Nr.", "Menge", "IdentNr" + blnSortNumeric = True + Case Else + blnSortNumeric = False + End Select + + + + ' If this is a new sort column, sort ascending. + ' Otherwise switch which sort order we use. + If m_SortColumn <> sort_column Then + If blnSortNumeric Then + m_SortOrder = flexSortNumericAscending + Else + m_SortOrder = flexSortStringNoCaseAscending + End If + ElseIf m_SortOrder = flexSortStringNoCaseAscending Or m_SortOrder = flexSortNumericAscending Then + If blnSortNumeric Then + m_SortOrder = flexSortNumericDescending + Else + m_SortOrder = flexSortStringNoCaseDescending + End If + Else + If blnSortNumeric Then + m_SortOrder = flexSortNumericAscending + Else + m_SortOrder = flexSortStringNoCaseAscending + End If + End If + MSFlexGrid1.sOrt = m_SortOrder + + + ' Restore the previous sort column's name. + If m_SortColumn >= 0 Then + MSFlexGrid1.TextMatrix(0, m_SortColumn) = _ + Mid$(MSFlexGrid1.TextMatrix(0, m_SortColumn), 3) + End If + + ' Display the new sort column's name. + m_SortColumn = sort_column + If m_SortOrder = flexSortStringNoCaseAscending Then + MSFlexGrid1.TextMatrix(0, m_SortColumn) = "> " & _ + MSFlexGrid1.TextMatrix(0, m_SortColumn) + Else + MSFlexGrid1.TextMatrix(0, m_SortColumn) = "< " & _ + MSFlexGrid1.TextMatrix(0, m_SortColumn) + End If + + ' Display the FlexGrid. + MSFlexGrid1.Visible = True +End Sub + +' +'' Sort by the indicated column. +'Private Sub SortByColumn(ByVal sort_column As Integer) +' ' Hide the FlexGrid. +' MSFlexGrid1.Visible = False +' MSFlexGrid1.Refresh +' +' ' Sort using the clicked column. +' MSFlexGrid1.col = sort_column +' MSFlexGrid1.ColSel = sort_column +' MSFlexGrid1.row = 0 +' MSFlexGrid1.RowSel = 0 +' +' ' If this is a new sort column, sort ascending. +' ' Otherwise switch which sort order we use. +' If m_SortColumn <> sort_column Then +' m_SortOrder = flexSortGenericAscending +' ElseIf m_SortOrder = flexSortGenericAscending Then +' m_SortOrder = flexSortGenericDescending +' Else +' m_SortOrder = flexSortGenericAscending +' End If +' +' MSFlexGrid1.sOrt = m_SortOrder +' +' ' Restore the previous sort column's name. +' If m_SortColumn >= 0 Then +' MSFlexGrid1.TextMatrix(0, m_SortColumn) = Mid$(MSFlexGrid1.TextMatrix(0, m_SortColumn), 3) +' End If +' +' ' Display the new sort column's name. +' m_SortColumn = sort_column +' If m_SortOrder = flexSortGenericAscending Then +' MSFlexGrid1.TextMatrix(0, m_SortColumn) = "> " & MSFlexGrid1.TextMatrix(0, m_SortColumn) +' Else +' MSFlexGrid1.TextMatrix(0, m_SortColumn) = "< " & MSFlexGrid1.TextMatrix(0, m_SortColumn) +' End If +' +'Debug.Print sort_column; MSFlexGrid1.col; m_SortColumn '@ +' +' ' Display the FlexGrid. +' MSFlexGrid1.Visible = True +'End Sub + +Private Sub PrintSenkrechteLinien(YStart As Double, yEnde As Double) + Dim i As Integer + For i = 1 To UBound(Tabs) + If Tabs(i) > 0 Or i = 0 Then + Printer.Line (Tabs(i) - 0.5, YStart)-(Tabs(i) - 0.5, yEnde), RGB(224, 224, 224) + End If + Next +End Sub + + +Private Sub FinePrintGrid() + Dim strTemp As String + Dim dblX As Double + Dim dblY As Double + Dim Seite As Integer + Dim i As Integer + Dim strAusblenden As String + Dim ZeileAufBlatt As Integer + Dim dblLastFontSize As Double + Dim lngFarbe As Long + Dim strLinie As String + Dim strAlteLinie As String + Dim lngSummeMenge As Long + + Dim dblYstart As Double + Dim dblYende As Double + + lngSummeMenge = Val(lblSumme) + + strAusblenden = m_strAusblenden + + Printer.ColorMode = 2 + Printer.Copies = Val(cmbAnzahlKopien.text) + + Printer.Font = "Arial" + Printer.ScaleMode = vbMillimeters + + Printer.ScaleLeft = -6 ' Rand + Printer.ScaleTop = -1 ' Rand + + '''''''''''''''''Seiten Kopf + Seite = 1 + Printer.currentY = 5 + Printer.Line (0, Int(Printer.currentY))-(Tabs(20), Int(Printer.currentY)) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) + + Printer.currentY = Printer.currentY + 1 + Printer.currentX = 5 + Printer.Font.Size = 15 + Printer.Font.Bold = True + + + Printer.FontTransparent = True + dblY = Printer.currentY + Printer.Print GetUeberschrift(strAusblenden) + + Printer.Font.Size = SCHRIFTTABELLE + Printer.Font.Bold = False + + Printer.currentY = dblY + Printer.currentX = 135 + Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") + Printer.currentY = Printer.currentY + 15 - SCHRIFTTABELLE + + Printer.currentY = Printer.currentY + 1 + + Printer.currentX = 10 + strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") + + Printer.Print strTemp + + strTemp = "Ort: " & GetFertOrtText() + + If txtFilterKunde.text <> "" Then + strTemp = strTemp & ", Kunde:" & txtFilterKunde.text & " " + End If + + If cmbKurzBez.text <> TEXTALLEKURZBEZ Then + Printer.FontBold = True + If strTemp <> "" Then strTemp = strTemp & ", nur " + strTemp = strTemp & cmbKurzBez.text + End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + Printer.FontBold = True + If strTemp <> "" Then strTemp = strTemp & ", " + For i = 0 To lstFilterTyp.ListCount - 1 + If lstFilterTyp.Selected(i) = True Then + strTemp = strTemp & lstFilterTyp.List(i) & ", " + End If + Next + End If + + + If cmbFilterNennweite.text <> TEXTALLE Then + Printer.FontBold = True + strTemp = strTemp & " DN " & cmbFilterNennweite.text + End If + + If cmbFilterTemp.text <> TEXTALLE Then + Printer.FontBold = True + strTemp = strTemp & " " & cmbFilterTemp.text & "°C " + End If + + If cmbFilterDruck.text <> TEXTALLE Then + Printer.FontBold = True + strTemp = strTemp & " PN " & cmbFilterDruck.text & " " + End If + + If cmbFilterBaulaenge.text <> TEXTALLE Then + Printer.FontBold = True + strTemp = strTemp & " L" & cmbFilterBaulaenge.text & " " + End If + + If cmbFilterMetrolog.text <> TEXTALLE Then + Printer.FontBold = True + strTemp = strTemp & ", Metrolog:" & cmbFilterMetrolog.text & " " + End If + + If chkNurCKD.Value = vbChecked Then + strTemp = strTemp & ", nur CKD " + End If + + If ChkOhnePlus.Value = vbChecked Then + strTemp = strTemp & ", kein PLUS " + End If + + If chkPlus.Value = vbChecked Then + strTemp = strTemp & ", nur PLUS " + End If + + If chkNoMoskauBadger.Value = vbChecked Then + strTemp = strTemp & ", ohne Moskau/Badger " + End If + + + If strAusblenden = "P" Then + strTemp = strTemp & ", keine FK u. FE " + End If + + If strAusblenden = "R" Then + strTemp = strTemp & ", nur PFL u. PSE " + End If + + + Printer.currentX = 10 + Printer.Print strTemp + Printer.FontBold = False + + Printer.currentY = Printer.currentY + 3 + + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) + + Dim Zeile As Integer + + ''''''''''''' Tabellenkopf + Printer.currentY = Printer.currentY + 3 + Call Tabellenkopf + + ' Obere Kante der Tabelle merken + dblY = Printer.currentY + 8 + dblYstart = dblY - 12 + ZeileAufBlatt = 0 + + Printer.currentY = dblY - 8 + + + For Zeile = 1 To mlngRecordsFound + ZeileAufBlatt = ZeileAufBlatt + 1 + + If Printer.currentY > 270 Then + ' Zeile passt nicht mehr aufs Blatt + PrintSenkrechteLinien dblYstart, Printer.currentY + + ZeileAufBlatt = 1 + Call SeitenFuss(strAusblenden, Seite) + + Printer.NewPage + Printer.Font.Size = SCHRIFTTABELLE + + Seite = Seite + 1 + StatusBar1.SimpleText = "Drucke Seite " & Seite + DoEvents + + Printer.currentY = 5 + Call Tabellenkopf + ' Obere Kante der Tabelle + dblY = Printer.currentY + 8 + dblYstart = dblY - 12 + End If + + Printer.currentY = dblY + + For i = 0 To MSFlexGrid1.cols - 1 + Printer.currentY = dblY + (ZeileAufBlatt - 2) * 5 + + If MSFlexGrid1.Rows <= Zeile Then + MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1 + End If + MSFlexGrid1.row = Zeile + MSFlexGrid1.col = i + strTemp = Trim(MSFlexGrid1.text) + Printer.Font.Size = 8 + Printer.Font.Bold = False + Select Case i + Case 0 + 'Versanddatum + Printer.Font.Bold = True + If strTemp <> "" Then + strTemp = Format(CDate(strTemp), "dd.mm") + End If + Case 1 + ' AuftragNr/Pos + Printer.Font.Bold = True + Case 2 + 'Kunden Ort + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Case 3 + 'IdentNr + If Len(strTemp) > 7 Then + Printer.fontSize = 6 + End If + Printer.Font.Bold = True + Case 4 + 'Menge + Printer.Font.Bold = True + Case 5 + ' Bezeichnung + + 'Printer.Font.Size = 6 + 'strTemp = Textformat(strTemp, i) + Printer.Font.Size = getFontSizeFromText(Printer, Tabs(i), Tabs(i + 1), strTemp & "*", 7) + + + Case 6 + ' Bohrung + strTemp = Textformat(strTemp, i) + Printer.Font.Size = 6 + Case 7 + Printer.Font.Size = 5 + Case 8, 9, 10, 11, 12, 13, 14, 15 ' QLAVEMPRD + Printer.Font.Size = 6 + Printer.Font.Bold = True + Case 16 ' Anzeige + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Case 17 ' Bemerkung + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Case 18 + 'ort + Case 19 + ' FA Nr + Printer.Font.Size = 8 + End Select + + If chkVersuch.Value = vbChecked Then + Select Case i + Case 6, 7 + ' SerienNrVon + Printer.Font.Size = 8 + Printer.Font.Bold = True + Case 8 ' Anzeige + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Case 9 ' Bemerkung + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Case 10 + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Printer.currentY = Printer.currentY + 1 + End Select + End If + + Printer.currentX = Tabs(i) + + Select Case i + Case 1, 3 + ' rechtsbündig + Printer.currentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 + Case 0, 4 + ' rechtsbündig + Printer.currentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 2 + End Select + + Select Case i + Case 17 + ' Bemerkung + Printer.currentY = Printer.currentY - 2 + Printer.currentX = Tabs(i) + Printer.Print Left(strTemp, 10) + Printer.currentX = Tabs(i) + Printer.Print Mid(strTemp, 11) + Printer.currentY = Printer.currentY + 1 + Case Else + Printer.Print strTemp + End Select + + dblLastFontSize = Printer.Font.Size + Printer.Font.Size = 8 + Next + + ' da letzte Spalte eine kleinere Schriftgroesse haben könnte + 'Printer.CurrentY = Printer.CurrentY + 2 + Printer.DrawWidth = 3 + + If Zeile < mlngRecordsFound Then + If strAusblenden <> "VF" Then + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + Else + If MSFlexGrid1.cols > 14 Then + ' es gibt Spalte Linie + strLinie = MSFlexGrid1.TextMatrix(Zeile + 1, 14) + If Zeile > 1 Then + strAlteLinie = MSFlexGrid1.TextMatrix(Zeile, 14) + Else + strAlteLinie = strLinie + End If + + If strAlteLinie <> strLinie Then + Printer.DrawStyle = vbSolid + lngFarbe = RGB(0, 0, 0) + Else + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + End If + Else + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + End If + End If + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY), lngFarbe + Else + Printer.DrawStyle = vbSolid + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) + Printer.currentY = Printer.currentY + 2 + + Dim dblTempHoehe As Double + dblTempHoehe = Printer.currentY + + Printer.Font.Bold = True + strTemp = "Summe: " & lngSummeMenge + Printer.currentX = Tabs(4 + 1) - Printer.TextWidth(strTemp) - 2 + Printer.Print strTemp + + Printer.currentY = dblTempHoehe + strTemp = "davon geprüft: " & lblGeprueft.Caption + Printer.currentX = Tabs(5 + 1) - Printer.TextWidth(strTemp) - 2 + Printer.Print strTemp + + dblTempHoehe = Printer.currentY + + 'Printer.CurrentY = dblTempHoehe + strTemp = "nicht zu prüfende ME, FE, FK: " & Val(lblNichtZuPruefende) + Printer.currentX = Tabs(4 + 1) - Printer.TextWidth(strTemp) - 2 + Printer.Print strTemp + + Printer.currentY = dblTempHoehe + + strTemp = "noch zu prüfen: " & lngSummeMenge - Val(lblGeprueft.Caption) - Val(lblNichtZuPruefende) + Printer.currentX = Tabs(5 + 1) - Printer.TextWidth(strTemp) - 2 + Printer.Print strTemp + + End If + + + DoEvents + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + Next + + PrintSenkrechteLinien dblYstart, Printer.currentY + + Printer.currentY = Printer.currentY + 3 + If Printer.currentY < 278 Then + Printer.Line (0, Printer.currentY)-(Tabs(20), Printer.currentY) + Printer.Line (0, Printer.currentY + 1)-(Tabs(20), Printer.currentY + 1) + End If + + + + SeitenFuss strAusblenden, Seite, " von " & Seite & " Seiten" + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + + + Printer.EndDoc +End Sub + +Private Sub FinePrintAuftragsInfo() + Dim rs As CRecordset + Dim strTemp As String + Dim ZeileAufBlatt As Integer + Dim dblY As Double + Dim Seite As Integer + + Dim i As Integer + Dim lngSummeMenge As Long + Dim dblLastFontSize As Double + + Set rs = m_rs + + If mlngRecordsFound = 0 Then Exit Sub + + Printer.ColorMode = 2 + Printer.Copies = Val(cmbAnzahlKopien.text) + + Printer.Font = "Arial" + Printer.ScaleMode = vbMillimeters + + Printer.ScaleLeft = -4 ' Rand + Printer.ScaleTop = -1 ' Rand + + '''''''''''''''''Seiten Kopf + Seite = 1 + Printer.currentY = 5 + Printer.Line (0, Int(Printer.currentY))-(TabsAuftr(20), Int(Printer.currentY)) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + + Printer.currentY = Printer.currentY + 1 + Printer.currentX = 5 + Printer.Font.Size = 15 + Printer.Font.Bold = True + + + Printer.FontTransparent = True + dblY = Printer.currentY + Printer.Print "Informationen zu Auftrag " & Val(txtFilterAuftrag.text) + Printer.Font.Size = SCHRIFTTABELLE + Printer.Font.Bold = False + + m_rs.MoveFirst + Printer.currentX = 5 + Printer.Print "Kunde " & m_rs.getStringValue("KundenName") & "," & m_rs.getStringValue("KundenOrt") & ", KndNr: " & m_rs.getLongValue("KundenNr") + + Printer.currentY = dblY + Printer.currentX = 147 + Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") + + Printer.currentY = Printer.currentY + 15 - SCHRIFTTABELLE + Printer.currentY = Printer.currentY + 1 + + Printer.currentX = 5 + strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") + Printer.Print strTemp + + Printer.currentY = Printer.currentY + 3 + + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + + Dim Zeile As Integer + + ''''''''''''' Tabellenkopf + Printer.currentY = Printer.currentY + 3 + Call TabellenkopfAlleAuftr + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + + ' Obere Kante der Tabelle merken + dblY = Printer.currentY + 8 + ZeileAufBlatt = 0 + + ' Spalten Linien +' For i = 0 To 13 +' Printer.Line (TabsAuftr(i), dblY)-(TabsAuftr(i), 270) +' Next + + Printer.currentY = dblY - 8 + + + For Zeile = 1 To mlngRecordsFound + ZeileAufBlatt = ZeileAufBlatt + 1 + + If Printer.currentY > 270 Then + ' Zeile passt nicht mehr aufs Blatt + + ZeileAufBlatt = 1 + Call SeitenFussAlleAuftr(Seite) + + Printer.NewPage + Printer.Font.Size = SCHRIFTTABELLE + + Seite = Seite + 1 + StatusBar1.SimpleText = "Drucke Seite " & Seite + DoEvents + + Printer.currentY = 5 + Call TabellenkopfAlleAuftr + ' Obere Kante der Tabelle + dblY = Printer.currentY + 8 + End If + + Printer.currentY = dblY + + For i = 0 To MSFlexGrid1.cols - 1 + Printer.currentY = dblY + (ZeileAufBlatt - 2) * 5 + MSFlexGrid1.row = Zeile + MSFlexGrid1.col = i + strTemp = Trim(MSFlexGrid1.text) + Printer.Font.Size = 8 + Printer.Font.Bold = False + Select Case i + Case 0 + 'Versanddatum + Printer.Font.Bold = True + strTemp = Format(CDate(strTemp), "dd.mm") + Case 1 + ' Auftrag/Pos + Printer.Font.Bold = True + Case 2 + 'IdentNr + Printer.Font.Bold = True + Case 3 + 'Menge + Printer.Font.Bold = True + Case 4 + ' Bezeichnung + Printer.Font.Size = 6 + strTemp = TextformatAuftragInfo(strTemp, i) + Case 5 + ' Bohrung + strTemp = TextformatAuftragInfo(strTemp, i) + Printer.Font.Size = 6 + Case 6 + ' MID + strTemp = TextformatAuftragInfo(strTemp, i) + Printer.Font.Size = 6 + Case 7, 8, 9, 10, 11, 12, 13, 14 'L A V E M P R D + Printer.Font.Size = 6 + Printer.Font.Bold = True + Case 15 ' Anzeige + Printer.Font.Size = 6 + strTemp = TextformatAuftragInfo(strTemp, i) + Case 15 ' Bemerkung + Printer.Font.Size = 6 + strTemp = TextformatAuftragInfo(strTemp, i) + Case 16 ' Status + strTemp = TextformatAuftragInfo(strTemp, i) + If strTemp = "offen" Then + Printer.Font.Size = 8 + Printer.Font.Bold = True + Else + Printer.Font.Size = 6 + Printer.Font.Bold = False + End If + End Select + + Printer.currentX = TabsAuftr(i) + + Select Case i + Case 0, 1, 2, 3 + ' rechtsbündig + ' versanddatum,Position, IdentNr, Menge + Printer.currentX = TabsAuftr(i + 1) - Printer.TextWidth(strTemp) - 2 + End Select + + Select Case i + Case 15 + ' Bemerkung + Printer.currentY = Printer.currentY - 0.5 + Printer.currentX = TabsAuftr(i) + Printer.Print Left(strTemp, 10) + Printer.currentX = TabsAuftr(i) + Printer.Print Mid(strTemp, 11) + Printer.currentY = Printer.currentY + 0.5 + Case Else + Printer.Print strTemp + End Select + + dblLastFontSize = Printer.Font.Size + Printer.Font.Size = 8 + + Debug.Print i & " " & strTemp + + Next + + ' da letzte Spalte eine kleinere Schriftgroesse haben könnte + Printer.currentY = Printer.currentY + 1 + + Printer.DrawWidth = 3 + + If Zeile < mlngRecordsFound Then + Printer.DrawStyle = vbDashDot + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY), RGB(224, 224, 224) + Else + Printer.DrawStyle = vbSolid + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + Printer.currentY = Printer.currentY + 2 + Printer.Font.Bold = True + dblY = Printer.currentY + strTemp = "Summe " & lblSumme.Caption + Printer.currentX = TabsAuftr(3 + 1) - Printer.TextWidth(strTemp) - 1 + Printer.Print strTemp + + Printer.currentY = dblY + strTemp = "offen: " & Val(labelOffenWert.Caption) & ", gefertigt: " & Val(labelGefertigtMenge.Caption) + Printer.currentX = TabsAuftr(5) + Printer.Print strTemp + End If + + + DoEvents + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + Next + + Printer.currentY = Printer.currentY + 3 + If Printer.currentY < 278 Then + Printer.Line (0, Printer.currentY)-(TabsAuftr(20), Printer.currentY) + Printer.Line (0, Printer.currentY + 1)-(TabsAuftr(20), Printer.currentY + 1) + End If + + SeitenFussAlleAuftr Seite, " von " & Seite & " Seiten" + If m_blnAbbruch Then + Call Abbruch + cmdAbbruch.Enabled = False + Exit Sub + End If + + Printer.EndDoc + +End Sub + +Private Sub FinePrintVersuch() + Dim strTemp As String + Dim ZeileAufBlatt As Integer + Dim dblY As Double + + Dim Seite As Integer + Dim i As Integer + Dim lngSummeMenge As Long + Dim dblLastFontSize As Double + + Dim strAlteLinie As String + Dim strLinie As String + Dim lngFarbe As Long + + lngSummeMenge = Val(lblSumme) + + Printer.ColorMode = 2 + Printer.Copies = Val(cmbAnzahlKopien.text) + + Printer.Font = "Arial" + Printer.ScaleMode = vbMillimeters + + Printer.ScaleLeft = -8 ' Rand + Printer.ScaleTop = -1 ' Rand + + '''''''''''''''''Seiten Kopf + Seite = 1 + Printer.currentY = 5 + Printer.Line (0, Int(Printer.currentY))-(Tabs(19), Int(Printer.currentY)) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(Tabs(19), Printer.currentY) + + Printer.currentY = Printer.currentY + 1 + Printer.currentX = 5 + Printer.Font.Size = 15 + Printer.Font.Bold = True + + + Printer.FontTransparent = True + dblY = Printer.currentY + Printer.Print GetUeberschrift(m_strAusblenden) + + Printer.Font.Size = SCHRIFTTABELLE + Printer.Font.Bold = False + + Printer.currentY = dblY + Printer.currentX = 130 + Printer.Print "Ausdruck vom " & Format(Now(), "dd.mm.yyyy hh:mm:ss") + Printer.currentY = Printer.currentY + 15 - SCHRIFTTABELLE + + Printer.currentY = Printer.currentY + 1 + + Printer.currentX = 10 + strTemp = "Auswahl vom: " & Format(DTPickerVon.Value, "dd.mm.yyyy") & " bis: " & Format(DTPickerBis.Value, "dd.mm.yyyy") + + + Printer.Print strTemp + + + strTemp = "Ort: " & GetFertOrtText() + + If txtFilterKunde.text <> "" Then + strTemp = strTemp & ", Kunden-Nr: " & txtFilterKunde.text + End If + + If cmbKurzBez.text <> TEXTALLEKURZBEZ Then + If strTemp <> "" Then strTemp = strTemp & ", nur " + strTemp = strTemp & cmbKurzBez.text + End If + + If lstFilterTyp.text <> TEXTALLETYPEN Then + For i = 0 To lstFilterTyp.ListCount - 1 + If strTemp <> "" Then strTemp = strTemp & ", " + If lstFilterTyp.Selected(i) = True Then + strTemp = strTemp & lstFilterTyp.List(i) + End If + Next + End If + + If cmbFilterNennweite.text <> TEXTALLE Then + strTemp = strTemp & " DN " & cmbFilterNennweite + End If + + If cmbFilterTemp.text <> TEXTALLE Then + strTemp = strTemp & " " & cmbFilterTemp & "°C " + End If + + If cmbFilterDruck.text <> TEXTALLE Then + strTemp = strTemp & " PN " & cmbFilterDruck & " " + End If + + If m_strAusblenden = "P" Then + strTemp = strTemp & ", keine FK u. FE " + End If + + If m_strAusblenden = "R" Then + strTemp = strTemp & ", nur PFL u. PSE " + End If + + Printer.currentX = 10 + Printer.Print strTemp + + + Printer.currentY = Printer.currentY + 3 + + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY) + Printer.currentY = Printer.currentY + 1 + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY) + + Dim Zeile As Integer + + + + + ''''''''''''' Tabellenkopf + Printer.currentY = Printer.currentY + 3 + + ''''''''''''''''''''''''''' + + Tabellenkopf + GoTo ueberspringen + + dblY = Printer.currentY + + Printer.Font.Bold = True + + For i = 0 To MSFlexGrid1.cols - 1 + MSFlexGrid1.row = 0 + MSFlexGrid1.col = i + Printer.currentY = dblY + Printer.currentX = Tabs(i) + + Select Case i + Case 0 + strTemp = "Fert." + Case 1 + strTemp = "AuftragNr/Pos" + Case 12 + strTemp = "Anz." + Case 16 + strTemp = "" + Case Else + strTemp = MSFlexGrid1.text + + End Select + + Select Case i + Case 1, 2, 3, 5, 6 + Printer.currentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 1 + End Select + + + Printer.Print strTemp + Next + +ueberspringen: + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY) + +'''''''''''''''''''''''''''# + ' Obere Kante der Tabelle merken + dblY = Printer.currentY + 8 + ZeileAufBlatt = 0 + + ' Spalten Linien + 'For i = 0 To 13 + ' Printer.Line (Tabs(i), dblY)-(Tabs(i), 270) + 'Next + + Printer.currentY = dblY - 8 + + For Zeile = 1 To mlngRecordsFound + ZeileAufBlatt = ZeileAufBlatt + 1 + If Printer.currentY > 270 Then + ' Zeile passt nicht mehr aufs Blatt + + ZeileAufBlatt = 1 + Call SeitenFuss(m_strAusblenden, Seite) + + Printer.NewPage + Printer.Font.Size = SCHRIFTTABELLE + + Seite = Seite + 1 + StatusBar1.SimpleText = "Drucke Seite " & Seite + DoEvents + + Printer.currentY = 5 + Call Tabellenkopf + ' Obere Kante der Tabelle + dblY = Printer.currentY + 8 + End If + + Printer.currentY = dblY + + For i = 0 To MSFlexGrid1.cols - 1 + + Printer.currentY = dblY + (ZeileAufBlatt - 2) * 5 + MSFlexGrid1.row = Zeile + MSFlexGrid1.col = i + strTemp = Trim(MSFlexGrid1.text) + Printer.Font.Name = "Arial" + Printer.Font.Size = 8 + Printer.Font.Bold = False + Select Case i + Case 0 + 'Versanddatum + strTemp = Format(CDate(strTemp), "dd.mm") + Case 1 + ' AuftragNr/Pos + Case 2 + 'IdentNr + Case 3 + 'Menge + Case 4 + ' Bezeichnung + Printer.Font.Size = 5 + strTemp = Textformat(strTemp, i) + Case 5, 6 ' SerienNr Von Bis + ' Printer.Font.Size = 8 + Case 7 ' Anzeige + If chkSonderlayoutFertigung.Value = vbUnchecked Then + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Else + 'SerienNr Von Bis + Printer.Font.Name = "Courier New" + End If + Case 8 ' Bemerkung oder Kundeneigene SerienNr + If chkSonderlayoutFertigung.Value = vbUnchecked Then + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Else + Printer.Font.Size = 7 + End If + Case 9 + If chkSonderlayoutFertigung.Value = vbUnchecked Then + ' ZusatzText + Printer.Font.Size = 6 + strTemp = Textformat(strTemp, i) + Printer.currentY = Printer.currentY + 1 + Else + Printer.Font.Size = 8 + End If + End Select + + Printer.currentX = Tabs(i) + + Select Case i + Case 0, 1, 2, 3, 5, 6 + ' rechtsbündig + Printer.currentX = Tabs(i + 1) - Printer.TextWidth(strTemp) - 2 + Case 7 + Debug.Print + End Select + + If chkSonderlayoutFertigung.Value = vbUnchecked Then + ' Drucken + Select Case i + Case 8 + ' Bemerkung + Printer.currentY = Printer.currentY - 1 + Printer.currentX = Tabs(i) + Printer.Print Left(strTemp, 10) + Printer.currentX = Tabs(i) + Printer.Print Mid(strTemp, 11) + Case 9 + ' Bemerkung + Printer.currentY = Printer.currentY - 2 + Printer.currentX = Tabs(i) + Printer.Print Left(strTemp, 10) + Printer.currentX = Tabs(i) + Printer.Print Mid(strTemp, 11) + Case Else + Printer.Print strTemp + End Select + Else + Debug.Print strTemp + Printer.Print strTemp + End If + + dblLastFontSize = Printer.Font.Size + Printer.Font.Size = 8 + Next + + ' da letzte Spalte eine kleinere Schriftgroesse haben könnte + 'Printer.CurrentY = Printer.CurrentY + 2 + Printer.DrawWidth = 3 + + If Zeile < mlngRecordsFound Then + If m_strAusblenden <> "VF" Then + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + Else + If MSFlexGrid1.cols > 15 Then + ' es gibt Spalte Linie + strLinie = MSFlexGrid1.TextMatrix(Zeile + 1, 14) + If Zeile > 1 Then + strAlteLinie = MSFlexGrid1.TextMatrix(Zeile, 14) + Else + strAlteLinie = strLinie + End If + + If strAlteLinie <> strLinie Then + Printer.DrawStyle = vbSolid + lngFarbe = RGB(0, 0, 0) + Else + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + End If + Else + Printer.DrawStyle = vbDashDot + lngFarbe = RGB(224, 224, 224) + End If + End If + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY), lngFarbe + Else + ' letzte Seite + Printer.DrawStyle = vbSolid + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY) + + Printer.currentY = Printer.currentY + 2 + Printer.Font.Bold = True + strTemp = "Summe " & lngSummeMenge + Printer.currentX = Tabs(3 + 1) - Printer.TextWidth(strTemp) - 2 + Printer.Print strTemp + End If + + + DoEvents + If m_blnAbbruch Then + Call Abbruch + Exit Sub + End If + Next + + Printer.currentY = Printer.currentY + 3 + If Printer.currentY < 278 Then + Printer.Line (0, Printer.currentY)-(Tabs(16), Printer.currentY) + Printer.Line (0, Printer.currentY + 1)-(Tabs(16), Printer.currentY + 1) + End If + + SeitenFuss m_strAusblenden, Seite, " von " & Seite & " Seiten" + If m_blnAbbruch Then + cmdAbbruch.Enabled = False + Call Abbruch + Exit Sub + End If + + Printer.EndDoc +End Sub + +Private Function getFontSizeFromText(printerobj As Printer, dblXlinks As Integer, dblXRechts As Integer, strText As String, Optional StartFontsize As Double = 8) As Double + getFontSizeFromText = StartFontsize + + printerobj.Font.Size = getFontSizeFromText + + Do While dblXRechts - dblXlinks < Printer.TextWidth(strText) + printerobj.Font.Size = getFontSizeFromText + getFontSizeFromText = getFontSizeFromText * 0.99 + Loop + +End Function + + +Private Function GetBaulaengeFromAuftragposition(AuftragNr As Long, PositionNr As Long, lngBestellgruppe As Long) As String + On Error GoTo Errorhandler + + Dim strBestellcode As String + Dim strBestellgruppe As String + Dim IdentNr As Long + Dim Bestellcode As CBestellcode + Dim strSql As String + + If AuftragNr = 0 Then Exit Function + If PositionNr = 0 Then Exit Function + If lngBestellgruppe = 0 Then Exit Function + + + strSql = "SELECT Bestellcode from Auftragposition where AuftragNr = " & AuftragNr & " and PositionNr = " & PositionNr + Dim rs As CRecordset + Set rs = New CRecordset + rs.openRS strSql, True + + If Not rs.EOF Then + strBestellcode = Trim(rs.getStringValue("Bestellcode") & "") + + Set Bestellcode = New CBestellcode + Bestellcode.Load strBestellcode, lngBestellgruppe + GetBaulaengeFromAuftragposition = Bestellcode.GetWert("Baulaenge") + Debug.Print AuftragNr & "/" & PositionNr & ", Baulänge=" & GetBaulaengeFromAuftragposition + End If +Exit Function + +Errorhandler: + LogIntoDB "Fehler " & Err.Number & " in GetBaulaengeFromAuftragposition: " & Err.Description, "SoftwareFehler" +End Function + +Private Function GetFilterOrt(Optional strFeldname As String = "Fert_Ort") As String + Dim i As Integer + Dim strOr As String + + For i = 0 To lstAPOrt.ListCount - 1 + If lstAPOrt.Selected(i) = True Then + If GetFilterOrt = "" Then + GetFilterOrt = " (" + End If + Select Case lstAPOrt.List(i) + Case TEXTALLELINIEN + ' trifft auf alle zu + GetFilterOrt = GetFilterOrt & strOr & " " & strFeldname & " <> 'XY' " + strOr = " OR " + Case TEXTALLELINIEN_OHNE_VS + GetFilterOrt = GetFilterOrt & strOr & " " & strFeldname & " <> 'VS' " + strOr = " OR " + Case Else + GetFilterOrt = GetFilterOrt & strOr & " " & strFeldname & " = '" & lstAPOrt.List(i) & "' " + strOr = " OR " + End Select + End If + Next + If GetFilterOrt <> "" Then + GetFilterOrt = GetFilterOrt & ") " + End If +End Function + +Private Function AnzahlDruckGepruefterZaehler(AuftragNr As Long, PositionNr As Long) As Long + On Error Resume Next + Dim strSql As String + Dim rs As CRecordset + + strSql = "SELECT distinct Druckpruefung.SerienNr, Druckpruefung.FabNr from Druckpruefung " + strSql = strSql & " where Druckpruefung.AuftragNr = " & AuftragNr & " AND Druckpruefung.PositionNr = " & PositionNr & " AND Enddruck > 0 and Pruefzeit > 0 " + + '''strSQL = "SELECT distinct SerienNr, FabNr, LaufendeNr, AuftragNr, PositionNr from Druckpruefung where AuftragNr = " & AuftragNr & " AND PositionNr = " & PositionNr & " AND Enddruck > 0 and Pruefzeit > 0 " + Debug.Print strSql + + Set rs = New CRecordset + 'rs.getRs.CursorType = adOpenStatic + rs.openRS strSql, True + + AnzahlDruckGepruefterZaehler = rs.RecordCount + + Set rs = Nothing +End Function + + +Private Function GetBemerkungText(ByRef rs As CRecordset, ByRef lngSummeGeprueft As Long) As String + Dim lngGeprueft As Long + Dim strTemp As String + + +' Aus AuftragInfoAnzeigen: +' If Not rs.isFieldNull("P_IstTermin") Then +' MSFlexGrid1.Text = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") +' Else +' If Not rs.isFieldNull("R_IstTermin") Then +' MSFlexGrid1.Text = "R:" & Format(rs.getDateValue("R_IstTermin"), "dd.mm") +' End If +' End If +' +' MSFlexGrid1.Text = Trim(MSFlexGrid1.Text & " " & rs.getStringValue("Bem_Fertigung")) +' +' ' neu RH 12.06.2007 Für Ort ZY soll die Farbe angezeigt werden, da die Temperatur = NULL ist +' If rs.getStringValue("Ort") = "ZY" And rs.getStringValue("Farbe") <> "" Then +' If MSFlexGrid1.Text <> "" Then MSFlexGrid1.Text = MSFlexGrid1.Text & "," +' MSFlexGrid1.Text = MSFlexGrid1.Text & rs.getStringValue("Farbe") +' End If + + + + GetBemerkungText = Trim(rs.getStringValue("Bem_Fertigung")) + + If chkVersuch.Value = vbChecked Then +' MSFlexGrid1.col = MSFlexGrid1.col + 1 ' 10 + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, Trim(Replace(rs.getStringValue("ZusatzText"), vbCrLf, " "))) + End If + + + If Not rs.isFieldNull("R_IstTermin") Then 'And rs.isFieldNull("P_IstTermin") Then + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, "R:" & Format(rs.getDateValue("R_IstTermin"), "dd.mm")) + End If + + lngGeprueft = 0 + If rs.getLongValue("TLMenge_P") > 0 Then + ' TL_Menge_P ist gesetzt (neu) + lngGeprueft = rs.getLongValue("TLMenge_P") - rs.getLongValue("TLMenge") + If rs.getLongValue("TLMenge_P") < rs.getLongValue("Menge") Then + ' noch nicht vollständig an der Prüfstation geprüft, also geprüfte Teilmenge anzeigen + strTemp = "P=" & rs.getLongValue("TLMenge_P") + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, strTemp) + Else + ' schon vollständig geprüft + If Not rs.isFieldNull("P_IstTermin") Then + ' Komplett an der Prüfstation fertiggemeldet, also Datum anziegen + strTemp = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, strTemp) + End If + End If + Else + ' hier ist rs.getLongValue("TLMenge_P") = 0 + ' TL_Menge_P ist noch nicht gesetzt (alt) + If Not rs.isFieldNull("P_IstTermin") Then + ' Komplett an der Prüfstation fertiggemeldet, hier kann nur die komplette Menge als geprüft erfasst werden + strTemp = "P:" & Format(rs.getDateValue("P_IstTermin"), "dd.m") + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, strTemp) + lngGeprueft = rs.getLongValue("Menge") - rs.getLongValue("TLMenge") + End If + End If + ' Summe der gerüften Zähler + + lngSummeGeprueft = lngSummeGeprueft + lngGeprueft + If lngGeprueft > rs.getLongValue("Menge") Then + LogIntoDB "fertigungslisten Anzeigen(): TLMenge_P > Menge !", "Datenfehler" + End If + + ' neu RH 12.06.2007 Für Ort ZY soll die Farbe angezeigt werden, da die Temperatur = NULL ist + If rs.getStringValue("Ort") = "ZY" And rs.getStringValue("Farbe") <> "" Then + If GetBemerkungText <> "" Then GetBemerkungText = GetBemerkungText & "," + GetBemerkungText = AddToTextIfNotExists(GetBemerkungText, rs.getStringValue("Farbe")) + End If + +End Function + + +Private Function getKundeneigeneSerienNr(lngAuftragNr As Long, lngPositionNr As Long, ByRef strKundeneigeneSerienNrVon As String, ByRef strKundeneigeneSerienNrBis As String) + Dim strSql As String + Dim rs As CRecordset + + strSql = "SELECT top 1 KundeneigeneSerienNr from AuftragPositionSerienNr where AuftragNr = " & lngAuftragNr & " and PositionNr = " & lngPositionNr & " order by SerienNr" + Set rs = New CRecordset + rs.openRS strSql, True + + If Not rs.EOF Then + strKundeneigeneSerienNrVon = rs.getStringValue("KundeneigeneSerienNr") + End If + + strSql = "SELECT top 1 KundeneigeneSerienNr from AuftragPositionSerienNr where AuftragNr = " & lngAuftragNr & " and PositionNr = " & lngPositionNr & " order by SerienNr desc" + Set rs = New CRecordset + rs.openRS strSql, True + If Not rs.EOF Then + strKundeneigeneSerienNrBis = rs.getStringValue("KundeneigeneSerienNr") + End If +End Function + + +Private Sub ExcelExport() + Const ERSTE_ZEILE = 2 + + Dim Zeile As Integer + Dim Spalte As Integer + Dim strText As String + + Dim myRange As range + Dim AnzalZeilen As Long + + Set mobjExcelApp = CreateObject("Excel.Application") + mobjExcelApp.Visible = True + Set mobjExcelWbk = mobjExcelApp.Workbooks.Add + mobjExcelWbk.Activate + Set mobjExelworksheet = mobjExcelWbk.ActiveSheet + + mobjExelworksheet.Name = "Fertigungsliste" + AnzalZeilen = MSFlexGrid1.Rows + + If AnzalZeilen < 2 Then Exit Sub + + SeiteEinrichten mobjExelworksheet, Int(AnzalZeilen / 79) + 1 + + + For Zeile = 0 To MSFlexGrid1.Rows - 1 + For Spalte = 0 To MSFlexGrid1.cols - 1 + strText = MSFlexGrid1.TextMatrix(Zeile, Spalte) + mobjExelworksheet.Cells(Zeile + ERSTE_ZEILE, Spalte + 1).Value = strText + MSFlexGrid1.row = Zeile + MSFlexGrid1.col = Spalte + If MSFlexGrid1.CellBackColor > 0 Then + mobjExelworksheet.Cells(Zeile + 2, Spalte + 1).Interior.Color = MSFlexGrid1.CellBackColor + End If + Next + Next + + Set myRange = mobjExelworksheet.range(mobjExelworksheet.Cells(ERSTE_ZEILE, 1), mobjExelworksheet.Cells(ERSTE_ZEILE, MSFlexGrid1.cols)) + myRange.Font.Bold = True + + + + ' Spaltenbreite anpassen + For Spalte = 1 To MSFlexGrid1.cols '-1 + mobjExelworksheet.Columns(Spalte).AutoFit + Next + + + + GitterUndRahmen mobjExelworksheet.range(mobjExelworksheet.Cells(ERSTE_ZEILE, 1), mobjExelworksheet.Cells(ERSTE_ZEILE + AnzalZeilen - 1, MSFlexGrid1.cols)) + + Zeile = ERSTE_ZEILE + AnzalZeilen + + If lblSumme.Caption <> "" And lblGeprueft.Caption <> "" Then + 'SummentextEinfuegen "noch zu prüfen:", Val(lblSumme.Caption) - Val(lblGeprueft.Caption) - Val(lblNichtZuPruefende.Caption), Zeile, 3 + SummentextEinfuegen "noch zu prüfen:", Val(labelOffenWert.Caption), Zeile, 3 + End If + + If lblGeprueft.Caption <> "" Then + Zeile = Zeile + 1 + SummentextEinfuegen "geprüft:", Val(lblGeprueft.Caption), Zeile, 3 + End If + + If chkStatistik.Value = vbChecked Or Trim(labelGefertigtMenge.Caption) <> "" Then + Zeile = Zeile + 1 + SummentextEinfuegen "Summe Zähler Statistik:", Val(labelGefertigtMenge.Caption), Zeile, 3 + End If + + If lblNichtZuPruefende.Caption <> "" Then + Zeile = Zeile + 1 + SummentextEinfuegen "nicht zu prüfende ME, FE, FK:", Val(lblNichtZuPruefende.Caption), Zeile, 3 + End If + + + If lblSumme.Caption <> "" Then + Zeile = Zeile + 1 + SummentextEinfuegen "Summe Zähler gesamt:", Val(lblSumme.Caption), Zeile, 3 + End If + + If lblSummeWert.Caption <> "" Then + Zeile = Zeile + 1 + SummentextEinfuegen "Summe Wert:", Val(lblSummeWert.Caption), Zeile, 3 + End If + + If txtFilterKunde.text = "Helwan" Then + Dim strTemp As String + + If InStr(1, cmbLot.text, ":") > 0 Then + strTemp = Split(cmbLot.text, ":")(0) + Else + strTemp = cmbLot.text + End If + + mobjExelworksheet.Cells(1, 5).Value = "Auftragsliste Helwan " & strTemp + + mobjExelworksheet.Cells(1, 5).Font.Bold = True + mobjExelworksheet.Cells(1, 5).HorizontalAlignment = xlCenter + + End If + + mobjExcelWbk.Activate + + Exit Sub +End Sub + + + +Public Sub GitterUndRahmen(selection As range) + selection.Borders(xlDiagonalDown).LineStyle = xlNone + selection.Borders(xlDiagonalUp).LineStyle = xlNone + + With selection.Borders(xlEdgeLeft) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = xlAutomatic + End With + With selection.Borders(xlEdgeTop) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = xlAutomatic + End With + With selection.Borders(xlEdgeBottom) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = xlAutomatic + End With + With selection.Borders(xlEdgeRight) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = xlAutomatic + End With + + With selection.Borders(xlInsideVertical) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = 48 + End With + With selection.Borders(xlInsideHorizontal) + .LineStyle = xlContinuous + .Weight = xlThin + .ColorIndex = 48 + End With + +End Sub + +Public Sub SummentextEinfuegen(strLabel As String, strWert As String, Zeile As Integer, Spalte As Integer) + mobjExelworksheet.Cells(Zeile, Spalte).Value = strLabel + mobjExelworksheet.Cells(Zeile, Spalte).HorizontalAlignment = xlRight + mobjExelworksheet.Cells(Zeile, Spalte).Font.Bold = True + + mobjExelworksheet.Cells(Zeile, Spalte + 1).Value = strWert + mobjExelworksheet.Cells(Zeile, Spalte + 1).HorizontalAlignment = xlRight + mobjExelworksheet.Cells(Zeile, Spalte + 1).Font.Bold = True +End Sub + +Public Sub SeiteEinrichten(ActiveSheet As Object, lngAnzahlSeiten As Long) + With ActiveSheet.PageSetup + .PrintTitleRows = "" + .PrintTitleColumns = "" + End With + + ActiveSheet.PageSetup.PrintArea = "" + + With ActiveSheet.PageSetup + .LeftHeader = "" + .CenterHeader = "" + .RightHeader = "" + .LeftFooter = "" + .CenterFooter = "" + .RightFooter = "" + .CenterFooter = "Erstellt von " & Mid(g_App.getMitarbeiter.getVorname, 1, 1) & "." & g_App.getMitarbeiter.getName & " am &D um &T" + .RightFooter = "Seite &P" + .LeftMargin = Application.InchesToPoints(0.393700787401575) + .RightMargin = Application.InchesToPoints(0.393700787401575) + .TopMargin = Application.InchesToPoints(0.393700787401575) + .BottomMargin = Application.InchesToPoints(0.393700787401575) + .HeaderMargin = Application.InchesToPoints(0.511811023622047) + .FooterMargin = Application.InchesToPoints(0.511811023622047) + .PrintHeadings = False + .PrintGridlines = False + .PrintComments = xlPrintNoComments + .PrintQuality = 600 + .CenterHorizontally = False + .CenterVertically = False + .Orientation = xlPortrait + .Draft = False + .PaperSize = xlPaperA4 + .FirstPageNumber = xlAutomatic + .Order = xlDownThenOver + .BlackAndWhite = False + .Zoom = False + .FitToPagesWide = 1 + .FitToPagesTall = lngAnzahlSeiten + End With +End Sub + + +Public Sub FlexGrid_To_Excel(TheFlexgrid As MSFlexGrid, _ + TheRows As Integer, TheCols As Integer, _ + Optional GridStyle As Integer = 1, Optional WorkSheetName _ + As String) + +Dim objXL As New Excel.Application +Dim wbXL As New Excel.Workbook +Dim mobjExelworksheet As New Excel.Worksheet +Dim intRow As Integer ' counter +Dim intCol As Integer ' counter + +If Not IsObject(objXL) Then + MsgBox "You need Microsoft Excel to use this function", _ + vbExclamation, "Print to Excel" + Exit Sub +End If + +'On Error Resume Next is necessary because +'someone may pass more rows +'or columns than the flexgrid has + +'you can instead check for this, +'or rewrite the function so that +'it exports all non-fixed cells +'to Excel + +On Error Resume Next + +' open Excel +objXL.Visible = True +Set wbXL = objXL.Workbooks.Add +Set mobjExelworksheet = objXL.ActiveSheet + +' name the worksheet +With mobjExelworksheet + If Not WorkSheetName = "" Then + .Name = WorkSheetName + End If +End With + +' fill worksheet +For intRow = 1 To TheRows + For intCol = 1 To TheCols + With TheFlexgrid + mobjExelworksheet.Cells(intRow, intCol).Value = _ + .TextMatrix(intRow - 1, intCol - 1) & " " + End With + Next +Next + +' format the look +For intCol = 1 To TheCols + mobjExelworksheet.Columns(intCol).AutoFit + 'mobjExelworksheet.Columns(intCol).AutoFormat (1) + mobjExelworksheet.range("a1", Right(mobjExelworksheet.Columns(TheCols).AddressLocal, _ + 1) & TheRows).AutoFormat GridStyle +Next + +End Sub + + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +'''''''''''''''' LOT +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +Private Function Lot_CheckEingabenOK() + If Val(txtAuftragVon.text) > 0 And Val(txtAuftragBis.text) > 0 And cmbLot.text <> "" Then + Lot_CheckEingabenOK = True + End If +End Function + + +Private Sub cmdLotHinzu_Click() + If cmbLot.text <> "" Then + + cmbLot.AddItem cmbLot.text & TRENNER1 & txtAuftragVon.text & " - " & txtAuftragBis.text + cmbLot.ListIndex = cmbLot.ListCount - 1 + + SaveLots + cmdLotHinzu.Enabled = False + + End If +End Sub + + +Private Sub SaveLots() + Dim i As Integer + Dim strListe As String + + strListe = "" + For i = 0 To cmbLot.ListCount - 1 + If cmbLot.List(i) <> "" Then + strListe = strListe & "|" & cmbLot.List(i) + End If + Next + strListe = Mid(strListe, 2) + g_App.Settings.saveStringValue "Fertigungslisten", "Lots", strListe + Debug.Print "strListe= " & strListe +End Sub + + + +Private Sub cmbLot_Click() + Dim strBereich As String + Dim strVon As String + Dim strBis As String + + If cmbLot.ListIndex > -1 Then + If cmbLot.ListIndex > 0 Then + cmdLotEntfernen.Enabled = True + End If + + If InStr(1, cmbLot.text, TRENNER1) > 0 Then + strBereich = Split(cmbLot.text, TRENNER1)(1) + + strVon = Split(strBereich, "-")(0) + strBis = Split(strBereich, "-")(1) + + txtAuftragVon.text = Val(strVon) + txtAuftragBis.text = Val(strBis) + +' txtAuftragVon.Enabled = False +' txtAuftragBis.Enabled = False + Else + txtAuftragVon.text = "" + txtAuftragBis.text = "" + End If + Else + cmdLotEntfernen.Enabled = False + End If + + If cmbLot.text = "" Then cmdLotEntfernen.Enabled = False +End Sub + +Private Sub cmbLot_KeyPress(KeyAscii As Integer) + 'txtVon.Text = "" + 'txtBis.Text = "" + + cmbLot.ListIndex = -1 + + If Lot_CheckEingabenOK() Then + cmdLotHinzu.Enabled = True + Else + cmdLotHinzu.Enabled = False + End If + + txtAuftragVon.Enabled = True + txtAuftragBis.Enabled = True +End Sub + + +Private Sub cmdLotEntfernen_Click() + If cmbLot.ListCount > 0 And cmbLot.ListIndex > -1 Then + cmbLot.RemoveItem cmbLot.ListIndex + End If + + If cmbLot.ListCount > 0 Then + cmbLot.ListIndex = 0 + Else + cmbLot.AddItem "" + cmbLot.text = "" + cmdLotEntfernen.Enabled = False + + g_App.Settings.saveStringValue "Fertigungslisten", "Lots", "" + End If + + SaveLots + +End Sub + + +Private Sub ResetLot() + Dim strListe As String + + txtAuftragVon.text = "" + txtAuftragBis.text = "" + +' txtAuftragVon.Enabled = False +' txtAuftragBis.Enabled = False + + cmdLotHinzu.Enabled = False + cmdLotEntfernen.Enabled = False + + + strListe = g_App.Settings.readStringValue("Fertigungslisten", "Lots", "") + + + Dim varElement As Variant + cmbLot.Clear + cmbLot.AddItem "" + For Each varElement In Split(strListe, TRENNER2) + cmbLot.AddItem varElement + Next + +End Sub + +Private Sub txtAuftragVon_Change() + If Lot_CheckEingabenOK() Then + cmdLotHinzu.Enabled = True + Else + cmdLotHinzu.Enabled = False + End If +End Sub + +Private Sub txtAuftragBis_Change() + If Lot_CheckEingabenOK() Then + cmdLotHinzu.Enabled = True + Else + cmdLotHinzu.Enabled = False + End If +End Sub + +Private Sub txtAuftragVon_GotFocus() + txtAuftragVon.SelStart = 0 + txtAuftragVon.SelLength = Len(txtAuftragVon.text) +End Sub + +Private Sub txtAuftragBis_GotFocus() + txtAuftragBis.SelStart = 0 + txtAuftragBis.SelLength = Len(txtAuftragBis.text) +End Sub + +Private Sub txtAuftragVon_KeyPress(KeyAscii As Integer) + Select Case KeyAscii + Case 48 To 57 + ' numerisch + Case 8, 1, 22, 3, 24 + Case Else + Debug.Print KeyAscii + KeyAscii = 0 + End Select +End Sub + +Private Sub txtAuftragBis_KeyPress(KeyAscii As Integer) + Select Case KeyAscii + Case 48 To 57 + ' numerisch + Case 8, 1, 22, 3, 24 + Case Else + Debug.Print KeyAscii + KeyAscii = 0 + End Select +End Sub + +Private Function GetWertFromZusatztext(strZusatztext As String, strName As String) As String + Dim lngPositionStart As Long + Dim lngPositionEnde As Long + + lngPositionStart = InStr(1, strZusatztext, strName) + If lngPositionStart > 0 Then + lngPositionStart = lngPositionStart + Len(strName) + If lngPositionStart > 0 Then + lngPositionEnde = InStr(lngPositionStart, strZusatztext, vbCrLf) + If lngPositionEnde > 0 Then + GetWertFromZusatztext = Trim(Mid(strZusatztext, lngPositionStart, lngPositionEnde - lngPositionStart)) + End If + End If + End If + +End Function + + +Private Function getMaterialFromVariantencode(strVariantencode As String, strIdentnrString As String) As String + Dim rs As CRecordset + Dim strSql As String + + strSql = "SELECT * from Material_Variantencode where Variantencode='" & Replace(strVariantencode, "'", "''") & "' and KonfigMat = '" & Replace(strIdentnrString, "'", "''") & "'" + Set rs = New CRecordset + rs.openRS strSql, True + + If Not rs.EOF Then + getMaterialFromVariantencode = Trim(rs.getStringValue("Material")) + End If +End Function + +Private Sub SetSpalteNameZuordnung() + Dim lngSpalte As Long + Set m_DicSpaltenname = New Dictionary + + m_DicSpaltenname.RemoveAll + For lngSpalte = 0 To MSFlexGrid1.cols - 1 + m_DicSpaltenname.Add MSFlexGrid1.TextMatrix(0, lngSpalte), lngSpalte + Next +End Sub + + +Private Sub SonderlisteLaserDrucken() + Dim lngZeile As Long + Dim lngSpalte As Long + Dim lngFANr As Long + + + lngSpalte = m_DicSpaltenname.Item("FA-Nr.") + + Printer.ScaleMode = vbMillimeters + Printer.ScaleLeft = -10 + Printer.ScaleTop = -10 + + Printer.fontSize = 12 + Printer.FontBold = True + Printer.Print + + Printer.Print "Liste Linie 1 - Laservorbereitung/Kennzeichnung " & Format(Now(), "dd.mm.yyyy") + + For lngZeile = 1 To MSFlexGrid1.Rows - 1 + lngFANr = Val(MSFlexGrid1.TextMatrix(lngZeile, lngSpalte)) + If lngFANr > 0 Then + DruckeSonderlisteLaserDatensatz lngFANr + DoEvents + End If + Next + + Printer.EndDoc +End Sub + + +Private Function FillWithSpace(strText As String, lngUpToCharsCount As Long) As String + If lngUpToCharsCount - Len(strText) > 0 Then + FillWithSpace = strText & Space(lngUpToCharsCount - Len(strText)) + Else + FillWithSpace = strText + End If +End Function + + + +Private Sub DruckeSonderlisteLaserDatensatz(lngFANr As Long) + Dim rs As CRecordset + Dim strSql As String + + Dim Auftrag As CAuftrag + Dim AuftragPosition As CAuftragPosition + Dim AuftragPositionSerienNr As CAuftragPositionSerienNr + + Dim IdentNr As CIdentNr + Dim Bestellcode As CBestellcode + Dim VakoCode As CVakoCode + Dim strTemp As String + + + Set AuftragPosition = New CAuftragPosition + AuftragPosition.LoadAusFertigungsauftragNr (lngFANr) + Set Auftrag = New CAuftrag + Auftrag.Load AuftragPosition.getAuftragNr, False + + If AuftragPosition.getIdentNr > 0 Then + Set IdentNr = New CIdentNr + IdentNr.loadForNr AuftragPosition.getIdentNr + End If + + If AuftragPosition.GetBestellcode() <> "" Then + Set Bestellcode = New CBestellcode + Bestellcode.Load AuftragPosition.GetBestellcode, IdentNr.GetBestellgruppe + End If + + If IdentNr.m_sVakoCode() <> "" Then + Set VakoCode = New CVakoCode + VakoCode.Load IdentNr.m_sVakoCode + End If + + Printer.FontBold = False + + + If Printer.currentY > Printer.ScaleHeight * 0.5 Then + Printer.Line (0, Printer.currentY)-(Printer.ScaleWidth * 0.85, Printer.currentY) + Printer.NewPage + Printer.currentY = 15 + End If + + Printer.Line (0, Printer.currentY)-(Printer.ScaleWidth * 0.85, Printer.currentY) + Printer.Print + Printer.Print + Const SPACECHARS = 32 + + Printer.Font.Name = "Courier New" + Printer.Font.Size = 8 + + 'Fertigungsauftrag: + Printer.Print FillWithSpace("Fertigungsauftrag:", SPACECHARS) & lngFANr + ' BARCODE!! + Printer.currentX = Printer.TextWidth(Space(SPACECHARS - 2)) + + Printer.Font.Name = "Code 128" + Printer.Font.Size = 48 + Printer.Print code128(CStr(lngFANr), True) + Printer.Font.Name = "Courier New" + Printer.Font.Size = 8 + Printer.Print + + Printer.Print FillWithSpace("Bereitstellung:", SPACECHARS) & AuftragPosition.getVersanddatum + Printer.Print FillWithSpace("Kundenauftrag:", SPACECHARS) & AuftragPosition.getAuftragNr & " / " & AuftragPosition.getNr + Printer.Print FillWithSpace("Kunde:", SPACECHARS) & Auftrag.getKunde.getName & " (" & Auftrag.GetKundennr & ")" + Printer.Print FillWithSpace("Ort:", SPACECHARS) & Auftrag.getKunde.getOrt + Printer.Print FillWithSpace("Stückzahl:", SPACECHARS) & AuftragPosition.getMenge + Printer.Print FillWithSpace("Material:", SPACECHARS) & AuftragPosition.getIdentNrObj.getVollBezeichnung + + Set AuftragPositionSerienNr = New CAuftragPositionSerienNr + If AuftragPosition.getMenge > 1 Then + AuftragPositionSerienNr.Load AuftragPosition.getSerienNummerVon, Auftrag.getNr + Printer.Print FillWithSpace("Seriennummer:", SPACECHARS) & AuftragPosition.getSerienNummerVon & " - " & AuftragPosition.getSerienNummerBis + strTemp = AuftragPositionSerienNr.getKundeneigeneSerienNr + AuftragPositionSerienNr.Load AuftragPosition.getSerienNummerBis, Auftrag.getNr + strTemp = strTemp & " - " & AuftragPositionSerienNr.getKundeneigeneSerienNr + Printer.Print FillWithSpace("Kundeneigene Seriennummer:", SPACECHARS) & strTemp + Else + AuftragPositionSerienNr.Load AuftragPosition.getSerienNummerVon, Auftrag.getNr + Printer.Print FillWithSpace("Seriennummer:", SPACECHARS) & AuftragPosition.getSerienNummerVon + Printer.Print FillWithSpace("Kundeneigene Seriennummer:", SPACECHARS) & AuftragPositionSerienNr.getKundeneigeneSerienNr + End If + + 'Basisnummer (Meistream) : + Printer.Print FillWithSpace("Kundenmaterialnummer:", SPACECHARS) & GetMerkmalFromZusatztext("Zulassungskennzeichen", AuftragPosition.getZusatztext) + Printer.Print + Printer.Print FillWithSpace("Produktausführung:", SPACECHARS) & GetMerkmalFromZusatztext("Produktausführung", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Zulassungskennzeichen:", SPACECHARS) & GetMerkmalFromZusatztext("Zulassungskennzeichen", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Kundenversion:", SPACECHARS) & GetMerkmalFromZusatztext("Kundenversion", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Nennweite DN:", SPACECHARS) & GetMerkmalFromZusatztext("Nennweite DN", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Nenndurchfluss:", SPACECHARS) & GetMerkmalFromZusatztext("Nenndurchfluss", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("metrol. Kl. / Verhältnis Q3/Q1:", SPACECHARS) & GetMerkmalFromZusatztext("metrol. Kl. / Verhältnis Q3/Q1", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Druckstufe:", SPACECHARS) & GetMerkmalFromZusatztext("Druckstufe", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Baulänge:", SPACECHARS) & GetMerkmalFromZusatztext("Baulänge", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Bohrbild:", SPACECHARS) & GetMerkmalFromZusatztext("Bohrbild", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Materialspezifikation:", SPACECHARS) & GetMerkmalFromZusatztext("Materialspezifikation", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Zählwerk:", SPACECHARS) & GetMerkmalFromZusatztext("Zählwerk", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Anzeige:", SPACECHARS) & GetMerkmalFromZusatztext("Anzeige", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Bestellcode MEISTREAM:", SPACECHARS); GetMerkmalFromZusatztext("Bestellcode MEISTREAM", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Zusatzhinweis:", SPACECHARS) & GetMerkmalFromZusatztext("Zusatzhinweis", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("CSD-Dokument:", SPACECHARS) & GetMerkmalFromZusatztext("CSD", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Eigentumsnummer von:", SPACECHARS) & GetMerkmalFromZusatztext("Eigentumsnummer von", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Eigentumsnummer bis:", SPACECHARS) & GetMerkmalFromZusatztext("Eigentumsnummer bis", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Inkrement:", SPACECHARS) & GetMerkmalFromZusatztext("Inkrement", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Präfix:", SPACECHARS) & GetMerkmalFromZusatztext("Präfix", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Suffix:", SPACECHARS) & GetMerkmalFromZusatztext("Suffix", AuftragPosition.getZusatztext) + Printer.Print FillWithSpace("Version:", SPACECHARS) & GetMerkmalFromZusatztext("Version", AuftragPosition.getZusatztext) + Printer.Print + Printer.Print +' Printer.Print "Zusatztext:" +' +' Printer.FontSize = 8 +' Printer.Font.Name = "Arial" +' Printer.ScaleLeft = -Printer.ScaleWidth / 5 +' Printer.Print +' Printer.Print AuftragPosition.getZusatztext +' +' Printer.Print "----Bestellcode---" +' Printer.Print Bestellcode.m_strDebug +' Printer.Font.Name = "Courier New" +' Printer.FontSize = 8 +' Printer.Print +' + +End Sub + +Private Function GetMerkmalFromZusatztext(strMerkmal As String, strZusatztext As String) As String + Dim strElement As Variant + + For Each strElement In Split(strZusatztext, vbCrLf) + Debug.Print strElement + If Left(strElement, Len(strMerkmal)) = strMerkmal Then + GetMerkmalFromZusatztext = Right(strElement, Len(strElement) - Len(strMerkmal)) + GetMerkmalFromZusatztext = Trim(Replace(GetMerkmalFromZusatztext, ":", "")) + Exit For + End If + Next + If GetMerkmalFromZusatztext = "" Then + Debug.Print "###" & strMerkmal & " ist nicht bekannt ###" + End If +End Function + + +Private Function getIdentNrTextFromRecordset(rs As CRecordset, strAusblenden) As String + Dim strVariantencode As String + Dim strIdentnrString As String + Dim strTemp As String + + ' Eingabe: + ' IdentnrString, Zusatztext + + strIdentnrString = Trim(rs.getStringValue("IdentnrString")) + Select Case strIdentnrString + ' Sonderbehandlung + Case "MODULMEI", "MODUL" + ' soll ersetzt werden durch Material aus Tabelle Material_Variantencode über Variantencode, falls vorhanden + ' Variantencode auslesen + strVariantencode = GetWertFromZusatztext(rs.getStringValue("Zusatztext"), "Bestellcode " & strIdentnrString & " :") + If strVariantencode <> "" Then + ' Variantencode ist vorhanden + ' Material aus Tabelle Material_Variantencode auslesen + strTemp = getMaterialFromVariantencode(strVariantencode, strIdentnrString) + If strTemp = "" Then + ' Material ist nicht vorhanden: Fallback auf IdentnrString + strTemp = rs.getStringValue("IdentnrString") + End If + Else + ' Variantencode ist NICHT vorhanden, KonfigMat = IdentNrstring anzeigen + ' Fallback auf IdentnrString + strTemp = strIdentnrString + End If + ' Tabellenzelle füllen + getIdentNrTextFromRecordset = strTemp + Case "" + If strAusblenden = "Sofort" Then + getIdentNrTextFromRecordset = rs.getStringValue("Kennzeichen") & rs.getLongValue("IdentNr") & rs.getStringValue("Kennzeichen2") + Else + If rs.getLongValue("Kundennr") = 1000 And Len(rs.getStringValue("Kennzeichen2")) > 0 Then + getIdentNrTextFromRecordset = rs.getLongValue("IdentNr") & rs.getStringValue("Kennzeichen2") + Else + Select Case rs.getLongValue("IdentNr") + Case 2100000 + getIdentNrTextFromRecordset = "MODUL*" + Case Else + getIdentNrTextFromRecordset = rs.getLongValue("IdentNr") + End Select + End If + End If + Case Else + getIdentNrTextFromRecordset = strIdentnrString + End Select + + If rs.getStringValue("SAP_Nummer") <> "" Then + getIdentNrTextFromRecordset = rs.getStringValue("SAP_Nummer") + End If +End Function + + +