Datenbankanbindung mit recordset

Regina_Meyer_45b524 · 9. November 2019 um 18:34

Hallo, liebe Leute
ich bin heute zum ersten Mal im Forum und habe gleich ein riesiges Problem, bei dessen Lösung ich auf Eure Hilfe rechne. Wir haben von unserem Dozenten ein Teilprogramm erhalten, indem die Daten aus einer Web-shop-Bestellung (frmBestell1) in einem Anzeigenblatt dargestellt werden soll und nach Akzeptierung der AGB’s und Datenschutzbestimmungen durch den Kunden (frmBestell2) in eine Datenbank-Datei (frmBestell)geschrieben werden. Dabei können Kundendaten redundant erfaßt werden. Mein Problem: nach Aufruf der Ole-Word-AGB und Ole-Word-Datenschutz gelingt es mir nicht, die Daten aus der frmBestell1 heraus in die frmBestell zu übergeben. Ich habe eine DB_An-Formular UDP=Userdefinierte Prozedur geschrieben, in der ich z.B. eingab:
rsBestell!Nachname = txtUserNachname.Text
rsBestell Update

Vielleicht hätte es funktioniert, wenn der aufruf direkt aus frmBestell1 heraus erfolgt wäre, geht aber nicht, da zuvor frmBestell2 ausgeführt werden muß und erst wenn mit dem OK-Button alle Bedingungen der Bestellung akzeptiert werden soll die Übergabe erfolgen
Zweites Problem: ich habe keine Ahnung, wie ich dann die Bestellung ausdrucken soll. Ich habe es mit dem Print-Befehl versucht und bin jämmerlich gescheitert. Wer kann helfen?

Sollte jemand die Programmdatei als VBA oder EXE-Datei benötigen, bitte email-Adresse angeben. Hier kann ich keine Programme als Anlage versenden, oder? Bitte entschuldigt die Länge der msg, aber es ist wirklich sehr wichtig für mich eine Lösung zu finden. Danke an alle, die sich die Mühe machen mir zu helfen

VERSION 5.00
Begin VB.Form frmLogin 
 BorderStyle = 1 'Fest Einfach
 Caption = " Anmeldung"
 ClientHeight = 1905
 ClientLeft = 2835
 ClientTop = 3480
 ClientWidth = 3765
 ControlBox = 0 'False
 Icon = "frmLogin.frx":0000
 LinkTopic = "Form1"
 MaxButton = 0 'False
 MinButton = 0 'False
 ScaleHeight = 1125.537
 ScaleMode = 0 'Benutzerdefiniert
 ScaleWidth = 3535.131
 StartUpPosition = 2 'Bildschirmmitte
 Begin VB.TextBox txtUserName 
 Height = 345
 Left = 1290
 TabIndex = 1
 Top = 120
 Width = 2325
 End
 Begin VB.CommandButton cmdOK 
 Caption = "OK"
 Default = -1 'True
 Height = 390
 Left = 1290
 TabIndex = 4
 Top = 1020
 Width = 1140
 End
 Begin VB.CommandButton cmdESC 
 Cancel = -1 'True
 Caption = "Abbrechen"
 Height = 390
 Left = 2475
 TabIndex = 5
 Top = 1020
 Width = 1140
 End
 Begin VB.TextBox txtPassword 
 Height = 345
 IMEMode = 3 'DISABLE
 Left = 1290
 PasswordChar = "\*"
 TabIndex = 3
 Top = 525
 Width = 2325
 End
 Begin VB.Label lblStatus 
 BackColor = &H00C0E0FF&
 BorderStyle = 1 'Fest Einfach
 Height = 255
 Left = 105
 TabIndex = 6
 Top = 1500
 Width = 3495
 End
 Begin VB.Label lblLabels 
 BackStyle = 0 'Transparent
 Caption = "&Benutzername:"
 Height = 270
 Index = 0
 Left = 105
 TabIndex = 0
 Top = 150
 Width = 1080
 End
 Begin VB.Label lblLabels 
 BackStyle = 0 'Transparent
 Caption = "&Kennwort:"
 Height = 270
 Index = 1
 Left = 105
 TabIndex = 2
 Top = 540
 Width = 1080
 End
 Begin VB.Image Image1 
 Height = 510
 Left = 30
 Picture = "frmLogin.frx":27A2
 Stretch = -1 'True
 Top = 15
 Width = 510
 End
End
Attribute VB\_Name = "frmLogin"
Attribute VB\_GlobalNameSpace = False
Attribute VB\_Creatable = False
Attribute VB\_PredeclaredId = True
Attribute VB\_Exposed = False
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Formular: frmLogin
' Zweck: Benutzeranmeldung
' Status: SDI
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Option Explicit
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Form
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Sub Form\_Load()
 '
End Sub
Private Sub Form\_Activate()
 Reset 'UDP
End Sub
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Commandbuttons
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Sub cmdESC\_Click()
 Reset 'UDP
 Unload Me
End Sub
Private Sub cmdOK\_Click()
 strUsername = txtUserName.Text
 strPassword = txtPassword.Text
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Eingaben vollständig?
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 If strUsername = "" Then
 Reset 'UDP
 Exit Sub
 End If
 If strPassword = "" Then
 Reset 'UDP
 Exit Sub
 End If
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Beides war ausgefüllt ...
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*

 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Eingaben auswerten
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 Suchen 'UDP
End Sub

' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Textboxen
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Sub txtPassword\_GotFocus()
 txtPassword.BackColor = vbYellow
End Sub
Private Sub txtPassword\_LostFocus()
 txtPassword.BackColor = vbWhite
End Sub
Private Sub txtUserName\_GotFocus()
 txtUserName.BackColor = vbYellow
End Sub
Private Sub txtUserName\_LostFocus()
 txtUserName.BackColor = vbWhite
End Sub
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' UDPs
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Sub Suchen() 'Suchen in DB
' Suchbegriff zusammensetzen Nachname = 'Geithner'
' Scharfe Suche
 strSuchbegriff = \_
 "U = " & \_
 "'" & \_
 strUsername & \_
 "'"
' Kontrollanzeige bei Bedarf MsgBox strSuchbegriff

' Startposition für die Suche wählen
 rsLogin.MoveFirst
' Suche durchführen
 rsLogin.Find strSuchbegriff
' Suchergebnis auswerten
 If rsLogin.EOF Then 'Nicht gefunden ...
 Reset 'UDP
 Else 'Gefunden
 If rsLogin!P = strPassword Then 'Pwd OK
 LoginOK 'UDP
 ReadSettings 'UDP
 Leave 'UDP
 Else
 Reset 'UDP
 End If
 End If
End Sub
Private Sub Reset() 'Default Settings
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Loginvariablen vorbesetzen
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 strUsername = ""
 strPassword = ""
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Textboxen vorbesetzen
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
''' txtUserName.Text = "" 'temporär auskommentiert
''' txtPassword.Text = ""

 txtUserName.Text = "Gei37" 'temporär vorbesetzt für Testzwecke
 txtPassword.Text = "Mir37"

 txtUserName.SetFocus
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Loginstatus (vor-)besetzen
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 blnLoginOK = False
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Recordsetposition zurücksetzen
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 rsLogin.MoveFirst 'Zum ersten DS
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 ' Statuszeile
 ' \*\*\*\*\*\*\*\*\*\*\*\*\*
 lblStatus.Caption = "Bitte Benutzername und Passwort eingeben!"
End Sub
Private Sub ReadSettings()
' ?
' ?
' ?
End Sub
Private Sub LoginOK() 'UDP
 '"Sub Main" wertet "blnLoginOk" aus ...
 strPassword = "" 'Wird nicht mehr benötigt
 'strUsername ist noch bekannt ...
 strUserGroup = rsLogin!G 'Usergroup auslesen

 intUserNr = rsLogin!LfdNr 'Kundennummer
 strUserVorname = rsLogin!Vorname 'Vorname
 strUserNachname = rsLogin!Nachname 'Nachname
 strUserStrasse = rsLogin!Strasse
 strUserPlz = rsLogin!Plz
 strUserOrt = rsLogin!Ort
 strUserStaat = rsLogin!Staat

 lblStatus.Caption = "OK!"
 blnLoginOK = True
End Sub
Private Sub Leave()
 Unload frmLogin
End Sub

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain 
 AutoShowChildren= 0 'False
 BackColor = &H8000000C&
 ClientHeight = 6075
 ClientLeft = 165
 ClientTop = 450
 ClientWidth = 10605
 Icon = "frmMain.frx":0000
 LinkTopic = "MDIForm1"
 StartUpPosition = 1 'Fenstermitte
 Begin MSComctlLib.ImageList imlMain 
 Left = 120
 Top = 4800
 \_ExtentX = 1005
 \_ExtentY = 1005
 BackColor = -2147483643
 MaskColor = 12632256
 \_Version = 393216
 End
 Begin MSComctlLib.Toolbar tlbMain 
 Align = 1 'Oben ausrichten
 Height = 630
 Left = 0
 TabIndex = 2
 Top = 270
 Width = 10605
 \_ExtentX = 18706
 \_ExtentY = 1111
 ButtonWidth = 609
 ButtonHeight = 953
 Appearance = 1
 \_Version = 393216
 BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
 NumButtons = 4
 BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
 Caption = "|"
 Key = "cmdGoNext"
 Object.ToolTipText = "Gehe zum nächsten DS"
 EndProperty
 BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
 Caption = "\>|"
 Key = "cmdGoLast"
 Object.ToolTipText = "Gehe zum letzten DS"
 EndProperty
 EndProperty
 End
 Begin MSComctlLib.ProgressBar prbMain 
 Align = 1 'Oben ausrichten
 Height = 270
 Left = 0
 TabIndex = 1
 Top = 0
 Width = 10605
 \_ExtentX = 18706
 \_ExtentY = 476
 \_Version = 393216
 Appearance = 1
 End
 Begin MSComctlLib.StatusBar stbMain 
 Align = 2 'Unten ausrichten
 Height = 330
 Left = 0
 TabIndex = 0
 Top = 5745
 Width = 10605
 \_ExtentX = 18706
 \_ExtentY = 582
 \_Version = 393216
 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
 NumPanels = 1
 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
 EndProperty
 EndProperty
 End
 Begin VB.Menu mnuFile 
 Caption = "Datei"
 Begin VB.Menu mnuFileExit 
 Caption = "Beenden"
 End
 End
 Begin VB.Menu mnuWork 
 Caption = "Arbeitsbereich"
 Begin VB.Menu mnuWork1 
 Caption = "Bestellung1"
 End
 Begin VB.Menu mnuWork2 
 Caption = "Bestellung2"
 End
 End
End
Attribute VB\_Name = "frmMain"
Attribute VB\_GlobalNameSpace = False
Attribute VB\_Creatable = False
Attribute VB\_PredeclaredId = True
Attribute VB\_Exposed = False
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Formular: frmMain
' Status: MDI Parent
' Zweck: Regiezentrum
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Option Explicit
Private Sub MDIForm\_Load()
 UDP\_Zustand1
End Sub
Private Sub tlbMain\_ButtonClick(ByVal Button As MSComctlLib.Button)
 '
End Sub
Private Sub mnuFileExit\_Click()
 strMsgTitle = strApp
 strMsgContent = "Programm beenden!" & vbCrLf & "Sind Sie sicher?"
 varMsgStyle = vbYesNo + vbQuestion
 varMsgAntwort = MsgBox(strMsgContent, varMsgStyle, strMsgTitle)
 If varMsgAntwort = vbYes Then
 Dim frm As Form 'Formulare entladen
 For Each frm In Forms
 Unload frm
 Next frm

 dbConArt.Close 'DB Connection schliessen
 dbConKd.Close 'DB Connection schliessen

 'Hier müsste unter der Prämisse hoher
 'Datensicherheit noch einiges mehr passieren

 End 'Programm beenden
 Else
 'Nix
 End If
End Sub
Private Sub mnuWork1\_Click()
 frmBestell1.Show
 frmBestell2.Hide
End Sub
Private Sub mnuWork2\_Click()
 frmBestell2.Show
 frmBestell1.Hide
End Sub
Private Sub UDP\_Zustand1()
 frmMain.Caption = strApp & " : " & "Regiezentrum"
 Me.Height = 8000
 Me.Width = 12000
 tlbMain.Enabled = False 'noch keine Verwendung ...
 tlbMain.Visible = False
 'frmArtikel.Show
 frmBestell1.Show
End Sub


VERSION 5.00
Begin VB.Form frmArtikel 
 ClientHeight = 4845
 ClientLeft = 60
 ClientTop = 60
 ClientWidth = 10080
 ControlBox = 0 'False
 Icon = "frmArtikel.frx":0000
 LinkTopic = "Form1"
 MDIChild = -1 'True
 ScaleHeight = 4845
 ScaleWidth = 10080
 WindowState = 2 'Maximiert
 Begin VB.CommandButton cmdWKClear 
 Caption = "Warenkorb löschen"
 Height = 510
 Left = 5850
 TabIndex = 22
 Top = 4155
 Width = 1980
 End
 Begin VB.CommandButton cmdWKMinus 
 Caption = ""
 Height = 495
 Left = 5040
 TabIndex = 10
 Top = 615
 Width = 615
 End
 Begin VB.TextBox txtP 
 BackColor = &H00E0E0E0&
 Enabled = 0 'False
 Height = 285
 Index = 2
 Left = 4200
 TabIndex = 7
 Top = 1335
 Width = 615
 End
 Begin VB.TextBox txtP 
 BackColor = &H00E0E0E0&
 Enabled = 0 'False
 Height = 285
 Index = 1
 Left = 4200
 TabIndex = 6
 Top = 975
 Width = 615
 End
 Begin VB.TextBox txtP 
 BackColor = &H00E0E0E0&
 Enabled = 0 'False
 Height = 285
 Index = 0
 Left = 4200
 TabIndex = 5
 Top = 615
 Width = 615
 End
 Begin VB.TextBox txtM 
 Height = 285
 Index = 2
 Left = 3480
 TabIndex = 4
 Top = 1335
 Width = 615
 End
 Begin VB.TextBox txtM 
 Height = 285
 Index = 1
 Left = 3480
 TabIndex = 3
 Top = 975
 Width = 615
 End
 Begin VB.TextBox txtM 
 Height = 285
 Index = 0
 Left = 3480
 TabIndex = 2
 Top = 615
 Width = 615
 End
 Begin VB.ListBox lstArtikel 
 Height = 1185
 Left = 1800
 Style = 1 'Kontrollkästchen
 TabIndex = 1
 Top = 615
 Width = 1455
 End
 Begin VB.ComboBox cboArtGrp 
 Height = 315
 Left = 240
 TabIndex = 0
 Top = 615
 Width = 1335
 End
 Begin VB.Label lblDurchschnitt 
 Alignment = 1 'Rechts
 BorderStyle = 1 'Fest Einfach
 Height = 255
 Left = 6960
 TabIndex = 20
 Top = 2160
 Width = 855
 End
 Begin VB.Label lblSumme 
 Alignment = 1 'Rechts
 BorderStyle = 1 'Fest Einfach
 Height = 255
 Left = 6960
 TabIndex = 19
 Top = 1920
 Width = 855
 End
 Begin VB.Label Label3 
 AutoSize = -1 'True
 Caption = "Durchschnitt"
 Height = 195
 Left = 5880
 TabIndex = 18
 Top = 2175
 Width = 900
 End
 Begin VB.Label Label2 
 AutoSize = -1 'True
 Caption = "Summe"
 Height = 195
 Left = 5880
 TabIndex = 17
 Top = 1920
 Width = 525
 End
 Begin VB.Label Label1 
 Caption = "Artikel bestellen"
 BeginProperty Font 
 Name = "MS Sans Serif"
 Size = 13.5
 Charset = 0
 Weight = 400
 Underline = 0 'False
 Italic = 0 'False
 Strikethrough = 0 'False
 EndProperty
 Height = 285
 Left = 285
 TabIndex = 15
 Top = -15
 Width = 7215
 End
 Begin VB.Label lblWarenkorb 
 AutoSize = -1 'True
 Caption = "Warenkorb"
 Height = 195
 Left = 5925
 TabIndex = 14
 Top = 375
 Width = 795
 End
 Begin VB.Label lblArtikel 
 AutoSize = -1 'True
 Caption = "Artikel"
 Height = 195
 Left = 1860
 TabIndex = 13
 Top = 375
 Width = 435
 End
 Begin VB.Label blblArtGrp 
 AutoSize = -1 'True
 Caption = "Artikelgruppe"
 Height = 195
 Left = 315
 TabIndex = 12
 Top = 390
 Width = 930
 End
 Begin VB.Label lblMenge 
 AutoSize = -1 'True
 Caption = "Menge"
 Height = 195
 Left = 3480
 TabIndex = 9
 Top = 375
 Width = 495
 End
 Begin VB.Label lblEinzelpreis 
 AutoSize = -1 'True
 Caption = "Preis"
 Height = 195
 Left = 4320
 TabIndex = 8
 Top = 375
 Width = 345
 End
End
Attribute VB\_Name = "frmArtikel"
Attribute VB\_GlobalNameSpace = False
Attribute VB\_Creatable = False
Attribute VB\_PredeclaredId = True
Attribute VB\_Exposed = False
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Formular: frmArtikel
' Status: MDI Child
' Zweck: Artikelbestellungen durch Kunden
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061118 1745
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Option Explicit

Private Sub Form\_Load()
 UDP\_Zustand\_1 'Zustand 1 := Ausgangszustand
End Sub
Private Sub cboArtGrp\_Click()
 ' ----------------------------
 ' 1 Filterstring basteln
 ' 2 Filtern von rsArtikel
 ' 3 Füllen von lstArtikel
 ' ----------------------------
 '1
 strFilter = "Art\_Gruppe=" & "'" & cboArtGrp.Text & "'"
 'MsgBox strFilter
 '2
 rsArtikel.Filter = strFilter
 '3
 UDP\_lstArtikel\_Fuellen
End Sub
Private Sub UDP\_cboArtGrp\_Fuellen()
 rsArtGrp.Sort = "Bez ASC"
 rsArtGrp.MoveFirst 'zum 1.
 cboArtGrp.Clear
 Do While Not rsArtGrp.EOF
 cboArtGrp.AddItem rsArtGrp!Bez
 rsArtGrp.MoveNext
 Loop
End Sub
Private Sub UDP\_lstArtikel\_Fuellen()
 rsArtikel.Sort = "Art\_Bez ASC"
 rsArtikel.MoveFirst 'zum 1.
 lstArtikel.Clear
 i = 0
 Do While Not rsArtikel.EOF
 lstArtikel.AddItem rsArtikel!Art\_Bez
 txtP(i).Text = rsArtikel!Art\_Preis
 rsArtikel.MoveNext
 i = i + 1
 Loop
End Sub
Private Sub cmdTest\_Click()
 For i = 0 To lstArtikel.ListCount - 1
 If lstArtikel.Selected(i) Then
 txtM(i).Enabled = True
 txtM(i).Text = "1"
 txtM(i).BackColor = vbWhite
 End If
 Next i
End Sub

Private Sub cmdWKMinus\_Click()
 For i = 0 To lstWarenkorb.ListCount - 1
 If lstWarenkorb.ListCount = i Then
 Exit For
 End If
 If lstWarenkorb.Selected(i) = True Then
 lstWarenkorb.RemoveItem (i)
 i = i - 1
 End If
 Next i

 'intBS reduzieren !!!

End Sub

Private Sub cmdWKPlus\_Click()
 For i = 0 To lstArtikel.ListCount - 1
 If lstArtikel.Selected(i) Then
 If Val(txtM(i).Text) \> 0 Then
 'Menge \* Preis
 intBP = (Val(txtM(i).Text) \* Val(txtP(i).Text))
 'kumulierte Bestellsumme
 intBS = intBS + intBP
 'MsgBox intBP
 strTemp = txtM(i).Text \_
 & " - " \_
 & txtP(i).Text \_
 & " - " \_
 & Str(intBP) \_
 & " - " \_
 & lstArtikel.List(i)
 lstWarenkorb.AddItem strTemp
 Else
 '
 End If

 Else
 '
 End If
 Next i

 lblSumme.Caption = intBS
 If intBS \> 0 Then 'Falle!
 intBD = intBS / lstWarenkorb.ListCount
 End If
 lblDurchschnitt.Caption = intBD

End Sub

Private Sub cmdWKClear\_Click()
 UDP\_Zustand\_1
End Sub
Private Sub UDP\_Zustand\_1()
 ' ----------------------------------
 ' Combobox
 ' ----------------------------------
' cboArtGrp.Clear
 UDP\_cboArtGrp\_Fuellen
 ' ----------------------------------
 ' Listboxen
 ' ----------------------------------
 lstArtikel.Clear
 lstWarenkorb.Clear
 lstArtikel.Enabled = True
 lstWarenkorb.Enabled = True
 ' ----------------------------------
 ' Textboxen
 ' ----------------------------------

 intBD = 0
 intBS = 0
 intBP = 0

 lblSumme.Caption = ""
 lblDurchschnitt.Caption = ""


 For i = 0 To txtM.Count - 1
 txtM(i).Text = ""
' txtM(i).Enabled = True
 txtM(i).BackColor = &HE0E0E0
 txtM(i).Enabled = False
 txtM(i).Text = "0"
 Next i
 For i = 0 To txtP.Count - 1
 txtP(i).Text = ""
 txtP(i).Enabled = False
 Next i
 ' ----------------------------------
 ' Commandbuttons
 ' ----------------------------------
 cmdWKPlus.Enabled = True
 ' ----------------------------------
 ' Sonstiges
 ' ----------------------------------
 '
End Sub

VERSION 5.00
Begin VB.Form frmBestell1 
 BackColor = &H00C0E0FF&
 BorderStyle = 1 'Fest Einfach
 Caption = "Bestellung - Schritt 1"
 ClientHeight = 4080
 ClientLeft = 45
 ClientTop = 330
 ClientWidth = 10080
 ControlBox = 0 'False
 LinkTopic = "Form1"
 MaxButton = 0 'False
 MDIChild = -1 'True
 MinButton = 0 'False
 Moveable = 0 'False
 ScaleHeight = 4080
 ScaleWidth = 10080
 Begin VB.TextBox txtUserStaat 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 8880
 TabIndex = 39
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 855
 End
 Begin VB.TextBox txtUserOrt 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 7920
 TabIndex = 38
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 855
 End
 Begin VB.TextBox txtUserPlz 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 6960
 TabIndex = 37
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 855
 End
 Begin VB.TextBox txtUserStrasse 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 4920
 TabIndex = 36
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 1935
 End
 Begin VB.CommandButton cmdOKPos2 
 Height = 285
 Left = 7320
 Picture = "frmBestell1.frx":0000
 Style = 1 'Grafisch
 TabIndex = 35
 TabStop = 0 'False
 Top = 3360
 Width = 375
 End
 Begin VB.CommandButton cmdOKPos1 
 Height = 285
 Left = 7320
 Picture = "frmBestell1.frx":014A
 Style = 1 'Grafisch
 TabIndex = 34
 TabStop = 0 'False
 Top = 3000
 Width = 375
 End
 Begin VB.TextBox txtUserKdNr 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 360
 TabIndex = 30
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 1095
 End
 Begin VB.CommandButton cmdPosX2 
 Height = 285
 Left = 9480
 Picture = "frmBestell1.frx":0294
 Style = 1 'Grafisch
 TabIndex = 29
 TabStop = 0 'False
 Top = 3360
 Width = 375
 End
 Begin VB.CommandButton cmdPosX1 
 Height = 285
 Left = 9480
 Picture = "frmBestell1.frx":03DE
 Style = 1 'Grafisch
 TabIndex = 28
 TabStop = 0 'False
 Top = 3000
 Width = 375
 End
 Begin VB.CommandButton cmdESC 
 Height = 615
 Left = 8280
 Picture = "frmBestell1.frx":0528
 Style = 1 'Grafisch
 TabIndex = 6
 ToolTipText = "Bestellung verwerfen"
 Top = 1800
 Width = 1620
 End
 Begin VB.CommandButton cmdOK 
 Height = 615
 Left = 6600
 Picture = "frmBestell1.frx":0672
 Style = 1 'Grafisch
 TabIndex = 5
 ToolTipText = "Bestellung übernehmen"
 Top = 1800
 Width = 1620
 End
 Begin VB.ComboBox cboArtikel2 
 Height = 315
 Left = 2880
 TabIndex = 3
 Top = 3360
 Width = 3375
 End
 Begin VB.TextBox txtGP2 
 Alignment = 1 'Rechts
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 8640
 TabIndex = 27
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3360
 Width = 735
 End
 Begin VB.TextBox txtEP2 
 Alignment = 1 'Rechts
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 7800
 TabIndex = 26
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3375
 Width = 735
 End
 Begin VB.TextBox txtM2 
 Alignment = 1 'Rechts
 Height = 285
 Left = 6600
 TabIndex = 4
 Text = "0"
 Top = 3375
 Width = 735
 End
 Begin VB.TextBox txtArtNr2 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 1560
 TabIndex = 25
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3375
 Width = 1215
 End
 Begin VB.TextBox txtPos2 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 360
 TabIndex = 24
 TabStop = 0 'False
 Tag = "NoEdit"
 Text = "2"
 Top = 3375
 Width = 1095
 End
 Begin VB.ComboBox cboArtikel1 
 Height = 315
 Left = 2880
 TabIndex = 1
 Top = 2985
 Width = 3375
 End
 Begin VB.TextBox txtGP1 
 Alignment = 1 'Rechts
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 8640
 TabIndex = 23
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3000
 Width = 735
 End
 Begin VB.TextBox txtEP1 
 Alignment = 1 'Rechts
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 7800
 TabIndex = 22
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3000
 Width = 735
 End
 Begin VB.TextBox txtM1 
 Alignment = 1 'Rechts
 Height = 285
 Left = 6600
 TabIndex = 2
 Text = "0"
 Top = 3000
 Width = 735
 End
 Begin VB.TextBox txtArtNr1 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 1560
 TabIndex = 21
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 3000
 Width = 1215
 End
 Begin VB.TextBox txtPos1 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 360
 TabIndex = 20
 TabStop = 0 'False
 Tag = "NoEdit"
 Text = "1"
 Top = 3000
 Width = 1095
 End
 Begin VB.TextBox txtBestellDat 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 1560
 TabIndex = 11
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 2040
 Width = 1215
 End
 Begin VB.TextBox txtBestellNr 
 Alignment = 2 'Zentriert
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 360
 TabIndex = 10
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 2040
 Width = 1095
 End
 Begin VB.TextBox txtUsernachname 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 2880
 TabIndex = 8
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 1935
 End
 Begin VB.TextBox txtUserVorname 
 BackColor = &H00E0E0E0&
 Height = 285
 Left = 1560
 TabIndex = 7
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 720
 Width = 1215
 End
 Begin VB.Label Label17 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Staat"
 Height = 195
 Left = 8880
 TabIndex = 43
 Top = 480
 Width = 375
 End
 Begin VB.Label Label16 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Ort"
 Height = 195
 Left = 7920
 TabIndex = 42
 Top = 480
 Width = 210
 End
 Begin VB.Label Label15 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Plz"
 Height = 195
 Left = 6960
 TabIndex = 41
 Top = 480
 Width = 210
 End
 Begin VB.Label Label12 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Strasse"
 Height = 195
 Left = 4920
 TabIndex = 40
 Top = 480
 Width = 525
 End
 Begin VB.Label Label14 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Nachname"
 Height = 195
 Left = 2880
 TabIndex = 33
 Top = 480
 Width = 780
 End
 Begin VB.Label Label13 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Vorname"
 Height = 195
 Left = 1560
 TabIndex = 32
 Top = 480
 Width = 630
 End
 Begin VB.Label Label2 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Nr."
 Height = 195
 Left = 360
 TabIndex = 31
 Top = 480
 Width = 210
 End
 Begin VB.Label Label11 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "GP"
 Height = 195
 Left = 8760
 TabIndex = 19
 Top = 2760
 Width = 225
 End
 Begin VB.Label Label10 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "EP"
 Height = 195
 Left = 7920
 TabIndex = 18
 Top = 2760
 Width = 210
 End
 Begin VB.Label Label9 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Menge"
 Height = 195
 Left = 6600
 TabIndex = 17
 Top = 2760
 Width = 495
 End
 Begin VB.Label Label8 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Pos."
 Height = 195
 Left = 360
 TabIndex = 16
 Top = 2760
 Width = 435
 End
 Begin VB.Label Label7 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Art.-Nr."
 Height = 195
 Left = 1680
 TabIndex = 15
 Top = 2760
 Width = 495
 End
 Begin VB.Label Label6 
 BackStyle = 0 'Transparent
 Caption = "Art.-Bez."
 Height = 255
 Left = 3000
 TabIndex = 14
 Top = 2760
 Width = 975
 End
 Begin VB.Label Label5 
 BackStyle = 0 'Transparent
 Caption = "Datum"
 Height = 375
 Left = 1560
 TabIndex = 13
 Top = 1800
 Width = 975
 End
 Begin VB.Label Label4 
 BackStyle = 0 'Transparent
 Caption = "Nr."
 Height = 255
 Left = 360
 TabIndex = 12
 Top = 1800
 Width = 975
 End
 Begin VB.Label Label3 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Bestellung"
 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 = 360
 TabIndex = 9
 Top = 1320
 Width = 1290
 End
 Begin VB.Label Label1 
 AutoSize = -1 'True
 BackStyle = 0 'Transparent
 Caption = "Kunde"
 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 = 360
 TabIndex = 0
 Top = 0
 Width = 780
 End
 Begin VB.Shape Shape1 
 BackColor = &H00FFFFC0&
 BackStyle = 1 'Undurchsichtig
 Height = 855
 Left = 120
 Top = 360
 Width = 9855
 End
 Begin VB.Shape Shape2 
 BackColor = &H00C0FFC0&
 BackStyle = 1 'Undurchsichtig
 Height = 2295
 Left = 120
 Top = 1680
 Width = 9855
 End
End
Attribute VB\_Name = "frmBestell1"
Attribute VB\_GlobalNameSpace = False
Attribute VB\_Creatable = False
Attribute VB\_PredeclaredId = True
Attribute VB\_Exposed = False
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Formular: frmBestell1
' Zweck: Bestellung - Schritt 1
' Status: MDI Child
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*Option Explicit
Option Explicit
Private Sub Form\_Load()
 UDP\_Zustand1
End Sub
Private Sub Form\_Activate()
' UDP\_Zustand1 ':smile:
End Sub
Private Sub cboArtikel1\_Click()
 'Artikel suchen
 strSuchbegriff = \_
 "Art\_Bez = " & \_
 "'" & \_
 cboArtikel1.Text & \_
 "'"
 rsArtikel.MoveFirst
 rsArtikel.Find strSuchbegriff
 If rsArtikel.EOF Then
 '
 Exit Sub
 Else
 txtArtNr1.Text = rsArtikel!LfdNr
 txtEP1.Text = rsArtikel!Art\_Preis
 End If
End Sub
Private Sub cboArtikel2\_Click()
 'Artikel suchen
 strSuchbegriff = \_
 "Art\_Bez = " & \_
 "'" & \_
 cboArtikel2.Text & \_
 "'"
 rsArtikel.MoveFirst
 rsArtikel.Find strSuchbegriff
 If rsArtikel.EOF Then
 '
 Exit Sub
 Else
 txtArtNr2.Text = rsArtikel!LfdNr
 txtEP2.Text = rsArtikel!Art\_Preis
 End If
End Sub
Private Sub cmdOKPos1\_Click()
 If txtM1.Text = "" Then
 Exit Sub
 Else
 'MsgBox "Weiter!"
 Dim intTemp As Integer
 intTemp = Val(txtM1.Text) \* Val(txtEP1.Text)
 'statt 'val' besser 'cdbl' character to double ,
 'um mit Dezimalstellen arbeiten zu können
 txtGP1.Text = intTemp
 End If
End Sub
Private Sub cmdOKPos2\_Click()
 If txtM2.Text = "" Then
 Exit Sub
 Else
 'MsgBox "Weiter!"
 Dim intTemp As Integer
 intTemp = Val(txtM2.Text) \* Val(txtEP2.Text)
 txtGP2.Text = intTemp
 End If
End Sub
Private Sub cmdPosX1\_Click()
' txtPos1.Text = ""
 txtArtNr1.Text = ""
 txtM1.Text = ""
 txtEP1.Text = ""
 txtGP1.Text = ""
 cboArtikel1.Text = ""
End Sub
Private Sub cmdPosX2\_Click()
' txtPos2.Text = ""
 txtArtNr2.Text = ""
 txtM2.Text = ""
 txtEP2.Text = ""
 txtGP2.Text = ""
 cboArtikel2.Text = ""
End Sub
Private Sub cmdOK\_Click()
 UDP\_Beleg\_Zusammenstellen
 frmBestell1.Hide
 frmBestell2.Show
End Sub
Private Sub cmdESC\_Click()
 UDP\_Zustand1
End Sub
Private Sub UDP\_Zustand1()
 'Formularlayout
 Me.Top = 0
 Me.Left = 0
 Me.Width = (frmMain.Width - 500)
 Me.Height = (frmMain.Height - 2000)

 'Controls schalten
 Dim ctl As Control
 For Each ctl In frmBestell1.Controls
 If TypeOf ctl Is TextBox Then
 If ctl.Tag = "NoEdit" Then
 ctl.Enabled = False
 End If
 If Left(ctl.Name, 6) "txtPos" Then
 ctl.Text = ""
 End If
 End If
 If TypeOf ctl Is ComboBox Then
 If ctl.Tag = "NoEdit" Then
 ctl.Enabled = False
 End If
 End If
 Next ctl

 'Kunde identifizieren
 txtUserVorname.Text = strUserVorname
 txtUsernachname.Text = strUserNachname
 txtUserKdNr.Text = intUserNr

 txtUserStrasse.Text = strUserStrasse
 txtUserPlz.Text = strUserPlz
 txtUserOrt.Text = strUserOrt
 txtUserStaat.Text = strUserStaat


 'Bestellung identifizieren
 txtBestellDat.Text = Format(Now(), "dd.mm.yyyy")
 UDP\_BestellNr

 'cboArtikel\_Fuellen
 rsArtikel.Sort = "Art\_Bez ASC"
 rsArtikel.MoveFirst 'zum 1.
 cboArtikel1.Clear
 cboArtikel2.Clear
 Do While Not rsArtikel.EOF
 cboArtikel1.AddItem rsArtikel!Art\_Bez
 cboArtikel2.AddItem rsArtikel!Art\_Bez
 rsArtikel.MoveNext
 Loop

 'rs auf Startposition
 rsArtikel.MoveFirst

End Sub
Private Sub UDP\_BestellNr()
 'Neue Bestellnummer ermitteln
 Dim intBestellNr As Integer
 intBestellNr = 1 'behelfsweise
 txtBestellNr.Text = intBestellNr
End Sub
Private Sub UDP\_Beleg\_Zusammenstellen()
 strBestellung = \_
 "Kunde: " & vbCrLf & \_
 "------" & vbCrLf & \_
 txtUserKdNr.Text & " " & \_
 txtUserVorname.Text & " " & \_
 txtUsernachname.Text & vbCrLf & \_
 "------" & vbCrLf
 strBestellung = \_
 strBestellung & \_
 "Bestellung Nr. : " & txtBestellNr.Text & " " & \_
 "vom : " & txtBestellDat.Text & vbCrLf & \_
 "------" & vbCrLf
 strBestellung = \_
 strBestellung & \_
 "Pos. - Art.Nr. - Art-Bez. - Menge - EP - GP" & vbCrLf & \_
 "------" & vbCrLf
 If Val(txtM1.Text) \> 0 Then
 strBestellung = \_
 strBestellung & \_
 txtPos1.Text & " - " & \_
 txtArtNr1.Text & " - " & \_
 cboArtikel1.Text & " - " & \_
 txtM1.Text & " - " & \_
 txtEP1.Text & " - " & \_
 txtGP1.Text & vbCrLf
 End If
 If Val(txtM2.Text) \> 0 Then
 strBestellung = \_
 strBestellung & \_
 txtPos2.Text & " - " & \_
 txtArtNr2.Text & " - " & \_
 cboArtikel2.Text & " - " & \_
 txtM2.Text & " - " & \_
 txtEP2.Text & " - " & \_
 txtGP2.Text & vbCrLf
 End If
End Sub

VERSION 5.00
Begin VB.Form frmBestell2 
 BackColor = &H00C0E0FF&
 Caption = "Bestellung - Schritt 2"
 ClientHeight = 4260
 ClientLeft = 60
 ClientTop = 345
 ClientWidth = 10050
 ControlBox = 0 'False
 LinkTopic = "Form1"
 MDIChild = -1 'True
 ScaleHeight = 4260
 ScaleWidth = 10050
 Begin VB.CheckBox chkDatenschutz 
 BackColor = &H00C0E0FF&
 Caption = "Ich habe die Datenschutzbestimmungen gelesen und bin damit einverstanden"
 BeginProperty Font 
 Name = "Tahoma"
 Size = 6
 Charset = 0
 Weight = 400
 Underline = 0 'False
 Italic = 0 'False
 Strikethrough = 0 'False
 EndProperty
 Height = 240
 Left = 990
 TabIndex = 4
 Top = 675
 Width = 4395
 End
 Begin VB.CheckBox chkAGB 
 BackColor = &H00C0E0FF&
 Caption = "Ich habe die AGB gelesn und bin damit einverstanden"
 BeginProperty Font 
 Name = "Tahoma"
 Size = 6
 Charset = 0
 Weight = 400
 Underline = 0 'False
 Italic = 0 'False
 Strikethrough = 0 'False
 EndProperty
 Height = 240
 Left = 990
 TabIndex = 3
 Top = 120
 Width = 3195
 End
 Begin VB.CommandButton cmdOK 
 Height = 615
 Left = 8070
 Picture = "frmBestell2.frx":0000
 Style = 1 'Grafisch
 TabIndex = 2
 ToolTipText = "Bestellung übernehmen"
 Top = 45
 Width = 885
 End
 Begin VB.CommandButton cmdESC 
 Height = 615
 Left = 9015
 Picture = "frmBestell2.frx":014A
 Style = 1 'Grafisch
 TabIndex = 1
 ToolTipText = "Bestellung verwerfen"
 Top = 45
 Width = 885
 End
 Begin VB.TextBox txtBestellung 
 Height = 3075
 Left = 360
 MultiLine = -1 'True
 ScrollBars = 2 'Vertikal
 TabIndex = 0
 TabStop = 0 'False
 Tag = "NoEdit"
 Top = 1080
 Width = 9540
 End
 Begin VB.OLE OLE2 
 BackStyle = 0 'Transparent
 Class = "Word.Document.8"
 DisplayType = 1 'Symbol
 Height = 465
 Left = 480
 OleObjectBlob = "frmBestell2.frx":0294
 SizeMode = 3 'Zoom
 SourceDoc = "\\fsstb\Mitarbeiter\Medwed\DV\_Prog\Semester\AWI6.2006.WS\AWI6.2006.WS\_20061221\DOCS\DS.doc"
 TabIndex = 6
 Top = 600
 Width = 420
 End
 Begin VB.OLE OLE1 
 BackStyle = 0 'Transparent
 Class = "Word.Document.8"
 DisplayType = 1 'Symbol
 Height = 465
 Left = 480
 OleObjectBlob = "frmBestell2.frx":1EAC
 SizeMode = 3 'Zoom
 SourceDoc = "\\fsstb\Mitarbeiter\Medwed\DV\_Prog\Semester\AWI6.2006.WS\AWI6.2006.WS\_20061221\DOCS\AGB.doc"
 TabIndex = 5
 Top = 120
 Width = 420
 End
End
Attribute VB\_Name = "frmBestell2"
Attribute VB\_GlobalNameSpace = False
Attribute VB\_Creatable = False
Attribute VB\_PredeclaredId = True
Attribute VB\_Exposed = False

' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Formular: frmBestell2
' Zweck: Bestellung - Schritt 2
' Status: MDI Child
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*Option Explicit
Private Sub Form\_Activate()
 UDP\_Zustand1
End Sub
Private Sub UDP\_Zustand1()
 Me.Top = 0
 Me.Left = 0
 Me.Width = (frmMain.Width - 500)
 Me.Height = (frmMain.Height - 2000)

 Dim ctl As Control
 For Each ctl In frmBestell1.Controls
 If TypeOf ctl Is TextBox Then
 If ctl.Tag = "NoEdit" Then
 ctl.Enabled = False
 End If
 End If
 Next ctl

 txtBestellung.Enabled = False
 txtBestellung.Text = strBestellung
End Sub
Private Sub cmdESC\_Click()
 strMsgTitle = strApp
 strMsgContent = "Bestellung verwerfen!" & vbCrLf & "Sind Sie sicher?"
 varMsgStyle = vbYesNo + vbQuestion
 varMsgAntwort = MsgBox(strMsgContent, varMsgStyle, strMsgTitle)
 If varMsgAntwort = vbYes Then
 'Benutzerinfo
 strMsgTitle = strApp
 strMsgContent = "Bestellung wurde verworfen!"
 varMsgStyle = vbOKOnly & vbInformation
 'Bestellforms aus dem Arbeitsspeicher
 Unload frmBestell1
 Unload frmBestell2
 'Hauptform anzeigen
 frmMain.Show
 'Startseite / Katalog anzeigen
 Else
 'Nix
 End If
End Sub
Private Sub cmdOK\_Click()
 'Prüfen auf Häkchen für DS und AGB fehlt noch

 UDP\_Bestellung\_Speichern………………………………’ UDP’ sollen erstellt werden 
 UDP\_Bestellung\_Drucken 'm. Vorschau, 

 'Benutzerinfo
 strMsgTitle = strApp
 strMsgContent = "Bestellung wurde erfasst!"
 varMsgStyle = vbOKOnly & vbInformation
 'Bestellforms aus dem Arbeitsspeicher
 Unload frmBestell1
 Unload frmBestell2
 'Hauptform anzeigen
 frmMain.Show
 'Startseite / Katalog anzeigen
End Sub
Private Sub UDP\_Bestellung\_Speichern()
 ' am Donnerstag ...
End Sub
Private Sub UDP\_Bestellung\_Drucken()
 ' am Donnerstag ...
End Sub


Attribute VB\_Name = "modMain"
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Modul: modMain
' Zweck: Allgemeine Prozeduren
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Option Explicit
Public Sub Main()
 UDP\_App\_Init
 UDP\_DB\_Init
 UDP\_Login
 ' ----------------------------
 ' Loginerfolg auswerten
 ' ----------------------------
 If blnLoginOK = True Then
 rsLogin.Close
 MsgBox "Herzlich willkommen, " & strUsername
 ' ----------------------------
 ' Verbindung zu Datentabelle herstellen / Recordset öffnen
 ' ----------------------------
 UDP\_Form\_Init
 Else
 rsLogin.Close
 MsgBox "Login fehlgeschlagen. Tschüs!"
 End
 End If
End Sub
Public Sub UDP\_App\_Init()
 strApp = "Webshop 1.0"
End Sub
Public Sub UDP\_Login()
 ' ----------------------------------------------------
 ' LOGIN
 ' ----------------------------------------------------
 frmLogin.Show vbModal
End Sub
Public Sub UDP\_DB\_Init()
 ' ----------------------------
 ' DB-Anbindung vornehmen
 ' ----------------------------
 strDB = "DB\mdbArtikel.mdb"
 dbConArt.Open \_
 "Provider=Microsoft.Jet.OLEDB.4.0;" & \_
 "Data Source= " & strDB
 strDB = "DB\mdbKunden.mdb"
 dbConKd.Open \_
 "Provider=Microsoft.Jet.OLEDB.4.0;" & \_
 "Data Source= " & strDB
 ' ----------------------------
 ' Datenzugriff Client oder Server einstellen
 ' ----------------------------
 rsLogin.CursorLocation = adUseClient
 rsKunden.CursorLocation = adUseClient
 rsArtikel.CursorLocation = adUseClient
 rsArtGrp.CursorLocation = adUseClient
 rsBestell.CursorLocation = adUseClient
 ' ----------------------------
 ' Verbindung zu Kundentabelle herstellen / Recordset öffnen
 rsLogin.Open "tbl\_Kunden", dbConKd, \_
 adOpenStatic, adLockPessimistic
 'Static
' rsKunden.Open "tbl\_Kunden", dbConKd, \_
' adOpenDynamic, adLockPessimistic
 'Dynamic
 ' ----------------------------
 ' ----------------------------
 ' Verbindung zu Artikeltabelle herstellen / Recordset öffnen
 ' ----------------------------
 rsArtikel.Open "tbl\_Artikel", dbConArt, \_
 adOpenStatic, adLockPessimistic
 'Static
 rsArtGrp.Open "tbl\_ArtGrp", dbConArt, \_
 adOpenStatic, adLockPessimistic
 'Static
 rsBestell.Open "tbl\_Bestell", dbConArt, \_
 adOpenStatic, adLockPessimistic

End Sub
Public Sub UDP\_Form\_Init()
 ' ----------------------------------------------------
 ' Hauptformular anzeigen
 ' ----------------------------------------------------
 frmMain.Show
End Sub
Public Sub UDP\_ReadSettings()
 ' ----------------------------------------------------
 ' Userspezifische Einstellungen lesen
 ' ----------------------------------------------------
End Sub
Public Sub UDP\_SaveSettings()
 ' ----------------------------------------------------
 ' Userspezifische Einstellungen sichern
 ' ----------------------------------------------------
End Sub

Attribute VB\_Name = "modDeclare"
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Modul: modDeclare
' Zweck: Deklaration öffentlicher Variablen
' Autor: Peter Medwed
' Version: 1.0
' Stand: 20061216
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Option Explicit
' ----------------------------
' Anwendungs-ID
' ----------------------------
Public strApp As String
' ----------------------------
' DB-Anbindung
' ----------------------------
Public strDB As String 'Name und Pfad der DB
Public dbConArt As New ADODB.Connection 'Connection Object für Artikel-DB
Public dbConKd As New ADODB.Connection 'Connection Object für Kunden-DB
Public rsLogin As New ADODB.Recordset 'Recordset Object
Public rsArtikel As New ADODB.Recordset 'Recordset Object
Public rsArtGrp As New ADODB.Recordset 'Recordset Object
Public rsKunden As New ADODB.Recordset 'Recordset Object
Public rsBestell As New ADODB.Recordset 'Recordset Object
' ----------------------------
' Login
' ----------------------------
Public blnLoginOK As Boolean 'Login-Status

Public strUsername As String 'Benutzername
Public strPassword As String 'Passwort
Public strUserGroup As String 'Benutzergruppe
 '"A" = Admin
 '"G" = Guest
 '"U" = User
Public strUserVorname As String 'Benutzergruppe
Public strUserNachname As String 'Benutzergruppe
Public intUserNr As Integer 'Benutzergruppe

Public strUserStrasse As String
Public strUserPlz As String
Public strUserOrt As String
Public strUserStaat As String


' ----------------------------
' Userspezifische Settings
' ----------------------------
 '?
 '?
 '?


' ----------------------------
' Bestellung
' ----------------------------
Public intBP As Integer 'Bestellposition
Public intBS As Integer 'Bestellsumme
Public intBD As Integer 'Bestelldurchschnitt

Public strBestellung As String 'Beleg

' ----------------------------
' Steuerlogik
' ----------------------------
Public strModus As String 'Bearbeitungsmodus
 '"B" = Browse
 '"A" = Add
 '"E" = Edit
 '"D" = Delete
' ----------------------------
' Zähler u. dgl.
' ----------------------------
Public i As Integer, j As Integer, k As Integer
Public n As Integer, m As Integer, o As Integer
Public x As Integer, y As Integer, z As Integer

' ----------------------------
' Msgbox
' ----------------------------
Public strMsgTitle As String
Public strMsgContent As String
Public varMsgStyle As Variant
Public varMsgAntwort As Variant
' ----------------------------
' für sonstige Zwecke
' ----------------------------
Public strSort As String 'Für das Sortieren im Reccordset
Public strSuchbegriff As String 'Für das Suchen im Reccordset
Public strFilter As String 'Für das Filtern im Reccordset

Public strTemp As String 'Für temporäre Strings

[MOD] - Tags eingefügt, das verbessert die Lesbarkeit.

Chewpapa_22ca98 · 9. November 2019 um 18:34

Hallo,

rsBestell!Nachname = txtUserNachname.Text
rsBestell Update

habe ich richtig verstanden, das Textfeld ‚txtUserNachname‘ ist auf einer anderen Form, der Form frmBestell2 ??? Dann genügt es zu schreiben:

rsBestell!Nachname = frmBestell2.txtUserNachname.Text
rsBestell Update

Zweites Problem: ich habe keine Ahnung, wie ich dann die
Bestellung ausdrucken soll. Ich habe es mit dem Print-Befehl
versucht und bin jämmerlich gescheitert. Wer kann helfen?

Das verstehe ich jetzt nicht ganz. Wo ist die Bestellung? Ist die grafisch schon aufbereitet? Ein Word-Dokument als Serienbrief? Word kann doch drucken. Access? Hast Du den Report schon fertig?

Sollte jemand die Programmdatei als VBA oder EXE-Datei
benötigen, bitte email-Adresse angeben. Hier kann ich keine
Programme als Anlage versenden, oder?

Nein, Anhänge sind hier nicht möglich, aber die Adressen der User stehen oben, für alle angemeldeten Mitglieder sichtbar.

Bitte keine Email-Adressen als Klartext in die Beiträge schreiben!
Die Beiträge werden mit Google zu finden sein, wenn der Beitrag erst mal archiviert ist, dann könnte das eine Spam-Flut auslösen. Wenn ich Mail-Adressen in Beiträgen bemerke, lösche ich die. Denke beim Schreiben von Beiträgen gelegentlich daran, daß der Beitrag auch in etlichen Jahren noch mit Google gefunden wird, wenn Jemand so ein Problem hat und bei Google eine Lösung sucht.

Aber VBA … Exel, Word oder Access? Mir nützt VBA-Code übrigens nichts, hab’ ich nicht. Ich habe nur VB6.

Gruß, Rainer

Anonym · 9. November 2019 um 18:35

Hallo Regina.

Bei dem Datenbank-Problem kann ich Dir wohl nicht helfen, aber bei dem Druck-Problem.

Grundsätzlich ist das mit dem Drucken sehr einfach, jedoch auch extrem umfangreich. Mit dem Print-Befehl liegst Du jedenfalls schon 'mal richtig, denn ich glaube nicht, daß Du das Formular einfach mit „PrintForm“ drucken willst.
Ich habe mir jetzt nicht Deinen ganzen Programm-Code durchgelesen, daher weiß ich nicht, ob da schon was zum Ausdrucken enthalten ist. Ich schreibe Dir einfach 'mal das grundsätzliche Prinzip für den Ausdruck einer einzigen DINA4-Seite auf:

Sub DruckTest()
'Schritt 1:
 'Standard-Werte festlegen
 Printer.PaperSize = vbPRPSA4
 Printer.PrintQuality = 600
 Printer.ScaleMode = vbMillimeters
 Printer.Orientation = vbPRORPortrait
 Printer.ColorMode = vbPRCMMonochrome
 Printer.DrawWidth = 1
 Printer.DrawMode = vbBlackness
 Printer.DrawStyle = vbSolid
 Printer.Font.Name = "Arial"
 Printer.Font.Bold = False
 Printer.Font.Italic = False
 Printer.Font.Strikethrough = False
 Printer.Font.Underline = False

'Schritt 2:
 'Schriftgröße, Koordinaten und zu druckenden Text festlegen
 Printer.Font.Size = 16
 Printer.CurrentX = 20
 Printer.CurrentY = 20
 Printer.Print "Test-Druck"

'Schritt 3:
 'Ausdruck starten
 Printer.EndDoc
End Sub

Die Schritte 1 und 2 können natürlich auch verschwimmen. Wenn sich z.B. die Schriftgröße nie ändert, würde man dieselbe ja in Schritt 1 schon festlegen.
Schritt 2 ist dann der Schritt, den Du einfach so oft wiederholst, bis alle Daten auf dem Papier sind.

So. Vielleicht hilft Dir das ja schon 'mal weiter.

Viele Grüße
Carsten

Chewpapa_22ca98 · 9. November 2019 um 18:35

Hallo Carsten,

bei VBA macht man das im Normalfall nicht so, wie Du es beschreibst.
Wenn es um Excel geht ist VBA ja mehr als Hilfe für die Excel-Blätter gedacht.
Wegen der Datenbank nehme ich an, daß es um Access geht und das bringt ein mächtiges Toll, ‚Report‘ mit, das für den Ausdruck da ist. Dort werden die Felder mehr oder weniger mit der Maus positioniert, es gibt speziell für Rechnungen o.ä. vorgefertigte Formulare die nur noch mit den richtigen Feldern der DB verknüpft werden. Das Handling des Printer-Objekts übernimmt Access, das muß man nicht selbst tun. Ich programmiere das auch oft und gern in VB selbst, aber effektiv ist das nicht. Was ich mit VB in drei Tagen schreibe, bekommt meim Kollege mit dem Report in drei Stunden besser hin.

Gruß, Rainer

Anonym · 9. November 2019 um 18:35

Hallo Rainer.

Ich bin eigentlich eher der Überzeugung, das es sich um eine Anwendungsprogrammierung in VB5 handelt. Ich glaube, daß MDI-Formulare nicht in VBA verfügbar sind.

> Private Sub MDIForm\_Load()  
> UDP\_Zustand1  
> End Sub

.

Viele Grüße
Carsten

Chewpapa_22ca98 · 9. November 2019 um 18:35

Hallo Carsten,

Ich bin eigentlich eher der Überzeugung, das es sich um eine
Anwendungsprogrammierung in VB5 handelt. Ich glaube, daß
MDI-Formulare nicht in VBA verfügbar sind.

Private Sub MDIForm_Load()
UDP_Zustand1
End Sub

ach so, dann habe ich Sollte jemand die Programmdatei als VBA … benötigen, wohl falsch interpretiert.

Ich sehe mir den Report in VB aber mal an, das könnte interessant sein.

Gruß, Rainer

Anonym · 9. November 2019 um 18:35

Hallo Rainer

ach so, dann habe ich Sollte jemand die Programmdatei als
VBA … benötigen, wohl falsch interpretiert.

Durchaus möglich.
Warum hast Du denn oder EXE-Datei durch Auslassungspunkte ersetzt?

Viele Grüße
Carsten

Chewpapa_22ca98 · 9. November 2019 um 18:35

Hallo Carsten,

Warum hast Du denn oder EXE-Datei durch
Auslassungspunkte ersetzt?

weil ich es in dem Zusammenhang für unwichtig gehalten habe. Bei der Entwicklung hilft eine fertig compilierte Exe ja nicht … kann man VBA überhaupt compilieren? Ich versuche mich gerade am ‚Datareport‘ in VB6. Schon mal gemacht? Ich bisher nur mit Access, mit VB6 noch nicht. Noch hab’ ich’s nicht.

Gruß, Rainer

Chewpapa_22ca98 · 9. November 2019 um 18:35

Hi Carsten,

OK, ich hab’s. Der erste Report ist gedruckt.

Gruß, Rainer

Regina_Meyer_45b524 · 9. November 2019 um 18:39

Hi Carsten,

OK, ich hab’s. Der erste Report ist gedruckt.

Gruß, Rainer

bitte sende doch Deinen Lösungsweg an mich! Nur zur Erinnerung ich hatte die Frage ins Bord gestellt.

Liege Grüße aus Berlin
regmey

P.S. Gehe ich recht in der Annahme, daß Dich von meinen 4-5 emails nur eine erreicht hat und zwar die ohne Text?

Chewpapa_22ca98 · 9. November 2019 um 18:39

Hallo,

bitte sende doch Deinen Lösungsweg an mich! Nur zur Erinnerung
ich hatte die Frage ins Bord gestellt.

ja, ich weiß. Meine Lösung kannst Du nicht direkt verwenden, weil Du Access-VBA verwendest und ich VB6.

P.S. Gehe ich recht in der Annahme, daß Dich von meinen 4-5
emails nur eine erreicht hat und zwar die ohne Text?

Mich hat nur eine Mail erreicht in der Du von einem Anhang gesprochen hast, der aber gefehlt hat. Weil ich aber kein Access habe, war das auch nicht so wichtig.

Ok, zum Problem. Als erstes benötigst Du eine Abfrage, die alle Elemente enthält, die Du drucken willst. Mit SQL kennst Du Dich gut genug aus?

Dann such Dir in Access den ‚Report‘. In Access97 ist der leicht zu finden. Ein neueres Access kenne ich nicht, da wird es aber auch nicht schwerer sein.

Dann suchst Du Dir die Vorlage für Bestellformulare, die ist beim Acces dabei. Dann baruchst Du nur noch per ‚drag and drop‘ die Felder aus der Tabelle auf das Formular zu legen und positionieren. Das wars dann schon, den Rest erledigt Access.

Gruß, Rainer