per VB Script Daten in Tabell
15.02.2017 16:57:01
Marcus
Ich habe eine Tabelle mit Userform gebaut. Diese Userform arbeitet so, wie ich es haben möchte.
Dann habe ich ein VB-Script geschrieben, um die Userform vom Desktop aufzurufen, ohne Excel vorher zu öffnen.
Allerdings wird der Satz nicht in der Excelltabelle abgespeichert. Wenn ich die Usserform aus Excel selber starte und wieder schließe funktioniert das sehr wohl.
Ich habe folgendes Script auf dem Desktop Liegen (Start Text.vbs):
Dim objExcel
Dim objWshShell
Set objExcel = WScript.CreateObject("Excel.Application")
Set objWshShell = CreateObject("WScript.Shell")
objExcel.Visible = FALSE
objExcel.DisplayAlerts = FALSE
'Excel Datei öffnen
objExcel.WorkBooks.Open "S:\4-Gemeinsame Ordner\Gebrauchtfahrzeuge\Test\Gebrauchtwagen Test.xlsm"
'Ein Excel-Makro starten
objExcel.Run "eingabe_klick"
'Excel schließen
objExcel.WorkBooks.Close
Set objExcel = Nothing
Set objWshShell = Nothing
Die Userform (noch nicht ganz fertig)
Private Sub CmdDatenInTabelle_Click()
Rem Daten in Tabelle und Useform schließen
Worksheets("tbl.gesamtdaten").Activate
Worksheets("tbl.gesamtdaten").EnableCalculation = False
Fahrzeugnummerfestlegen:
If Not IsNumeric(TxtFahrzeugnummer) Then MsgBox " Bitte keine Buchstaben oder _
Leerzeichen eingeben ", vbOKOnly, "Fahrzeugnummer": TxtFahrzeugnummer = "": GoTo fehler1
If TxtFahrzeugnummer 0 Then MsgBox " Bitte Fahrzeugnummer _
_
_
_
ohne Komma eingeben ", vbOKOnly, "Fahrzeugnummer": TxtFahrzeugnummer = "": GoTo fehler1
If Cells(TxtFahrzeugnummer + 1, 1) "" And Cells(TxtFahrzeugnummer + 1, 2) "" Then _
_
_
_
MsgBox " Nummer schon vergeben ", vbOKOnly, "Fahrzeugnummer": TxtFahrzeugnummer = "": GoTo _
fehler1
Rem GoTo FINeingeben
FINeingeben:
If TxtFin = "" Then MsgBox " Bitte Fahrgestellnummer eingeben", vbOKOnly, " _
Fahrgestellnummer": GoTo fehler1
If Len(TxtFin) 17 Then MsgBox " Länge der FIN verkehrt, es werden 17 Stellen benö _
tigt ", vbkonly, "Fahrgestellnummer": GoTo fehler1
Rem GoTo zu21eingeben
zu21eingeben:
If Txtzu21 = "" Then MsgBox " Bitte Schlüsselnummer zu 2.1 eingeben", vbOKOnly, "Schlü _
_
_
_
sselnummernummer 2.1": GoTo fehler1
If Len(Txtzu21) 4 Then MsgBox " Länge der Schlüsselnummer verkehrt, es werden 4 _
Stellen benötigt ", vbkonly, "Schlüsselnummernummer 2.1": GoTo fehler1
Rem GoTo zu22eingeben
zu22eingeben:
If Txtzu22 = "" Then MsgBox " Bitte Schlüsselnummer zu 2.2 eingeben", vbOKOnly, "Schlü _
_
_
_
sselnummernummer 2.2": GoTo fehler1
Rem GoTo Herstellerauswählen
Herstellerauswählen:
If CmbHersteller = "" Then MsgBox " Bitte Hersteller wählen", vbOKOnly, "Hersteller": _
_
_
_
GoTo fehler1
Rem GoTo Fahrzeugtypwählen
Fahrzeugtypwählen:
If CmbFahrzeugtyp = "" Then MsgBox " Bitte Fahrzeugtyp wählen", vbOKOnly, "Fahrzeugtyp": _
_
_
_
GoTo fehler1
Rem GoTo Fahrzeugausführungwählen
Fahrzeugausführungwählen:
If CmbHochFlach = "" Then MsgBox " Bitte Fahrzeugausführung wählen", vbOKOnly, " _
Fahrzeugausführung": GoTo fehler1
Rem GoTo Fahrzeugausführungwählen
Fahrzeuglängewählen:
If CmbKurzLang = "" Then MsgBox " Bitte Fahrzeuglänge wählen", vbOKOnly, "Fahrzeuglänge" _
_
_
_
: GoTo fehler1
Rem GoTo Radstandwählen
Radstandwählen:
If CmbRadstand = "" Then MsgBox " Bitte Radstand wählen", vbOKOnly, "Radstand": GoTo _
fehler1
Rem GoTo ZulässigesGesamtgewichteingeben
ZulässigesGesamtgewichteingeben:
If TxtZulGesamtgewicht = "" Then MsgBox " Bitte zulässiges Gesamtgewicht in KG eingeben" _
_
_
_
, vbOKOnly, "Gesamtgewicht": GoTo fehler1
Rem GoTo Nutzlasteingeben
Nutzlasteingeben:
If TxtNutzlast = "" Or Val(TxtNutzlast) >= Val(TxtZulGesamtgewicht) Then MsgBox " Bitte _
_
_
_
Nutzlast eingeben, nicht größer als das zulässige Gesamtgewicht", vbOKOnly, "Nutzlast": GoTo _
_
_
fehler1
Rem GoTo KmStandeingeben
KmStandeingeben:
If TxtKMStand = "" Then MsgBox " Bitte KM-Stand eingeben", vbOKOnly, "KM-Stand": GoTo _
_
_
_
fehler1
Rem GoTo ErstzulassungEingeben
ErstzulassungEingeben:
If CmbKalenderTag = "" Or CmbKalenderMonat = "" Or CmbKalenderJahr = "" Then MsgBox " _
_
_
_
Bitte Datum der Erstzulassung eingeben", vbOKOnly, "Erstzulassung": GoTo fehler1
TxtErstzulassung = DateSerial(CmbKalenderJahr, CmbKalenderMonat, CmbKalenderTag)
Rem Goto TÜV eingeben
TüvEingeben:
If CmbTuevMonat = "" Or CmbTuevJahr = "" Then MsgBox " Bitte TÜV Daten eingeben", _
vbOKOnly, "Erstzulassung": GoTo fehler1
TxtTuev = (CmbTuevMonat / CmbTuevJahr)
Worksheets("tbl.gesamtdaten").EnableCalculation = True
ZuordnungTabelle:
Cells(TxtFahrzeugnummer + 1, 1) = Format(TxtFahrzeugnummer, "0#")
Cells(TxtFahrzeugnummer + 1, 2) = Format(TxtFin, ">")
Cells(TxtFahrzeugnummer + 1, 3) = Txtzu21: Cells(TxtFahrzeugnummer + 1, 3).NumberFormat _
_
_
_
= "0000"
Cells(TxtFahrzeugnummer + 1, 4) = Format(Txtzu22, ">")
Cells(TxtFahrzeugnummer + 1, 5) = CmbHersteller.Value
Cells(TxtFahrzeugnummer + 1, 6) = CmbFahrzeugtyp.Value
Cells(TxtFahrzeugnummer + 1, 7) = CmbHochFlach.Value
Cells(TxtFahrzeugnummer + 1, 8) = CmbKurzLang.Value
Cells(TxtFahrzeugnummer + 1, 9) = Format(CmbRadstand, "#####"" mm""")
Cells(TxtFahrzeugnummer + 1, 10) = Format(TxtZulGesamtgewicht.Value, "#####"" Kg""")
Cells(TxtFahrzeugnummer + 1, 11) = Format(TxtNutzlast.Value, "#####"" Kg""")
Cells(TxtFahrzeugnummer + 1, 12) = Format(TxtKMStand, "###,###"" Km""")
Cells(TxtFahrzeugnummer + 1, 13) = TxtErstzulassung: Cells(TxtFahrzeugnummer + 1, 13). _
_
_
_
NumberFormat = "dd.mm.yyyy"
Cells(TxtFahrzeugnummer + 1, 14) = TxtTuev: Cells(TxtFahrzeugnummer + 1, 14). _
NumberFormat = "mm/yy"
Unload Me
fehler1:
Rem Fehler bei Eingabe
Exit Sub
End Sub
Kann mir da jemand helfen
Vielen Dank im Voraus