Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
384to388
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
384to388
384to388
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Warum geht folgendes Makro nicht?

Warum geht folgendes Makro nicht?
20.02.2004 11:56:29
Markus H.
Moin Leute,

Habe dieses Makro erweitert und Frage mich warum es nicht geht wie ich das will..
Es soll prüfen ob eine Datei offen ist die mit Lieferschein anfängt und mit .xls aufhört! die werte dazwischen können varieren!
hier das makro:

Function WkbExist(SFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(SFile)
If Err = 0 And Not wkb Is Nothing Then
WkbExist = True
End If
On Error GoTo 0
End Function


Sub Datenholen()
Application.ScreenUpdating = False
Dim SFile As String
SFile = Left("Lieferschein", 12) & Right(".xls", 4)
Windows(Left("Lieferschein", 12) & Right(".xls", 4)).Activate
Hoffe mir kann jemand helfen..
Markus

                    

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Warum geht folgendes Makro nicht?
20.02.2004 12:25:13
Alex K.
Hallo Markus,
habe das Makro getestet, läuft wunderbar. Kann also nur an SFile liegen, welchen Wert übergibst du denn hier. Lass dir den Inhalt mal anzeigen, dann kommst du bestimmt drauf.
?
20.02.2004 12:29:22
Markus H.
Moin,
wenn du eine Datei offen hast die "Lieferschein 0815.xls" heißt kommt keine fehlermeldung?
MfG
Markus
Geht alles
20.02.2004 12:33:20
Alex K.
Hallo Markus,
geht wunderbur, auch mit deinem vorgeschlagenen Namen. Deshalb checke mal, was du im Paramter SFile übergibst. Setze mal einen Haltepunkt in dem Makro und schaue dir den Inhalt von SFile an!
nope.. geht nit!
20.02.2004 12:38:59
Markus H.
Moin,
er gibt mir aus:
Lieferschein.xls
ist ja auch irgendwie logisch! er soll aber erkennen ob eine Datei mit Lieferschein anfängt und mit .xls aufhört!
die werte dazwischen ändern sich!
Lieferschein 12a.xls
LieferscheinZinnwald.xls
usw.
mfg
markus
Anzeige
AW: nope.. geht nit!
20.02.2004 12:46:37
Alex K.
Hallo Markus,
jetzt habe ich dein Problem verstanden.
Mein Lösungsverschlag:

Function WkbExist(SFile As String) As Boolean
Dim wkb As Workbook
For Each wkb In Workbooks
If wkb.name Like SFile & "*" Then
WkbExist = True
Exit Function
End If
Next wkb
End Function

Aufruf der Funktion nur mit ersten Namensteil
WkbExist("Lieferschein")
hmm wie setzt ich das mit dem rest zusammen?
20.02.2004 12:51:54
Markus H.
Moin,
wie sieht dann das komplette script aus?
mfG
Markus
AW: hmm wie setzt ich das mit dem rest zusammen?
20.02.2004 13:04:10
Alex K.
Hallo Markus,
kann ich hellsehen? Ich habe dir die komplette Funktion zum Checken eingestellt. Wann und wie du diese Funktion aufrufst, kann ich nicht wissen. Da brauche ich schon den Code zum Aufrufen!
Ich gehe mal davon aus, dass du den vollen Namen der Arbeitsmappe hast und nun nur nach Lieferschein abfragen willst. Der Aufrufcode sieht dann so aus:

WkbExist(Left(WkbName, len("Lieferschein"))

Dieser Code würde nur den ersten Teil des Namens in der Länge "Lieferschein" übergeben. Wenn die Mappe dann mit diesem Namen beginnt, wird die Mappe als offenen erkannt.
Anzeige
noch mal der ganze script:
20.02.2004 13:14:08
Markus H.
Moin,
sorry.. vielleicht stell ich mich blöd an.. aber ich bekomms nicht hin..
hier ist der gesamte script:
______________


Function WkbExist(SFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(SFile)
If Err = 0 And Not wkb Is Nothing Then
WkbExist = True
End If
On Error GoTo 0
End Function


Sub Datenholen()
Application.ScreenUpdating = False
Dim SFile As String
SFile = "Lieferschein.xls"
If WkbExist(SFile) Then
Windows("Lieferschein.xls").Activate
Sheets("Lieferschein").Range("A11:D18").Select
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("A11:D18").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("Lieferschein.xls").Activate
Sheets("Lieferschein").Range("C22:F25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("C22:F25").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("Lieferschein.xls").Activate
Sheets("Lieferschein").Range("A28:G40").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("A28:G40").Select
ActiveSheet.Paste
Range("B12").Select
Windows("Lieferschein.xls").Activate
If MsgBox("Lieferschein ausdrucken?", vbYesNo, "Drucken?") = vbYes Then
Sheets("Lieferschein").PrintOut
Workbooks("Lieferschein.xls").Save
Workbooks("Lieferschein.xls").Close
Else
If MsgBox("Lieferschein.xls wird geschlossen!", vbOKOnly + vbCritical, "Schließen") = vbOK Then
Workbooks("Lieferschein.xls").Save
Workbooks("Lieferschein.xls").Close
End If
End If
Else
MsgBox "Bitte Lieferschein.xls öffnen", vbCritical, "Fehler"
Exit Sub
End If
End Sub

Meine Programmierweise ist bestimmt nicht sehr vorteilhaft, aber so wie es jetzt ist funzt es, wenn die datei Lieferschein.xls heißt.
Hoffe du kannst mir das umbauen..
MfG
Markus
Anzeige
AW: noch mal der ganze script:
20.02.2004 13:31:37
Alex K.
Hallo Markus,
hier mal mein Vorschlag. Wichtig ist natürlich, dass nach wie vor ein Tabellenblatt "Lieferschein" in der Datei "Lieferschein *.xls" existert. Ausserdem findet das Makro die erste offene Datei mit den Namen "Lieferschein*". Wenn mehrere offen sind, wird nur die erste bearbeitet.

Sub Datenholen()
Dim wbk     As Workbook
Application.ScreenUpdating = False
Set wbk = WkbExist("Lieferschein")
If wbk Is Nothing Then
MsgBox "Bitte Lieferschein*.xls öffnen", vbCritical, "Fehler"
Exit Sub
End If
With wbk
.Activate
Sheets("Lieferschein").Range("A11:D18").Select
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("A11:D18").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows("Lieferschein.xls").Activate
Sheets("Lieferschein").Range("C22:F25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("C22:F25").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Activate
Sheets("Lieferschein").Range("A28:G40").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Mit freundlicher Unterstützung von Markus H.").Activate
Sheets("Rechnung").Range("A28:G40").Select
ActiveSheet.Paste
Range("B12").Select
.Activate
If MsgBox("Lieferschein ausdrucken?", vbYesNo, "Drucken?") = vbYes Then
Sheets("Lieferschein").PrintOut
.Save
.Close
Else
If MsgBox("Lieferschein.xls wird geschlossen!", vbOKOnly + vbCritical, "Schließen") = vbOK Then
.Save
.Close
End If
End If
End With
End Sub
Function WkbExist(SFile As String) As Workbook
Dim wkb As Workbook
For Each wkb In Workbooks
If wkb.name Like SFile & "*" Then
Set WkbExist = wkb
Exit Function
End If
Next wkb
Set wkb = Nothing
End Function

Anzeige
vielen vielen lieben dank! OT
20.02.2004 13:39:58
Markus H.
funzt guddi..^^
danke
Super, wenigstens ein Erfolg heuter :-) oT
20.02.2004 13:47:44
Alex K.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige