Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1076to1080
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1076to1080
1076to1080
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro abbrechen

Makro abbrechen
30.05.2009 16:18:42
Werner
Hallo zusammen,
ich habe mal wieder ein Problem. Das Folgende Makro.....

Private Sub CommandButtonTabelle1_Click()
Dim vLinks, ii As Integer, strB As String
Dim lstrFile As String, liLW As Integer
Application.EnableEvents = False
On Error GoTo fehler:
For liLW = 67 To 90
If Dir(Chr(liLW) & ":Mitarbeiterablage.xls")  "" _
Then
lstrFile = Chr(liLW) & ":Mitarbeiterablage.xls" _
On Error GoTo 0
Exit For
weiter:
End If
Next
If lstrFile = "" Then
MsgBox "Auf keinem der Laufwerke von C: - Z: existiert eine Datei mit dem Namen '' _
Mitarbeiterablage.xls ''" & vbCrLf & "oder das Verzeichnis ''\Kalkulation-Kostenrechnung-Römerbad'' ist nicht vorhanden", vbExclamation, "Hinweis"
Exit Sub
End If
Workbooks.Open Filename:=lstrFile
Windows("KalkulationKostenrechnungRömerbad25_08_2008.xls").Activate
Sheets("Tabelle1").Select
Sheets("Tabelle1").Copy after:=Workbooks("Mitarbeiterablage.xls").Sheets(1)
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Shapes("CommandButtonMA1").Left = Range("F1").Left  'CommandButton  _
Positionieren
ActiveSheet.Shapes("CommandButtonMA1").Top = Range("F1").Top
strB = ActiveSheet.Cells(2, 2)              ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
Workbooks("Mitarbeiterablage.xls").Close True      ' Mitarbeiterablage speichern + schließen
Else
ActiveSheet.Name = strB
Workbooks("Mitarbeiterablage.xls").Close True
End If
Windows("KalkulationKostenrechnungRömerbad25_08_2008.xls").Activate
Sheets("Tabelle1").Select
Sheets("Tabelle1").Range("B3,B4,B5,E2,E3,K9:O47,G10:I10,E15:G18,J14,V11:V22,AA11:AC22,P14:P17"). _
ClearContents
Range("A6") = 2
Range("A7") = 1
Sheets("Startcenter").Range("D12") = "Mitarbeiter 1"
Exit Sub
fehler:
Resume weiter
Application.EnableEvents = True
End Sub


....soll durchlaufen werden bis zu dem Punkt ' Blatt umbenennen
wenn die Msg Box auftaucht kann ich mit OK bestädigen und dann wird das Blatt unter z.B "Tabelle1"
gespeichert. Meine Frage wäre folgende, kann ich das Makro an dieser Stelle Abbrechen wobei das Blatt wieder am Ursprungsort bleiben soll, so das ich da einen neuen Namen vergeben kann (denn es ist ja zu diesen Zeitpunkt schon in der Mitarbeiterablage drinn ?
Viele Grüße Werner

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
mit strB=Inputbox("Name") ? 0wT
30.05.2009 16:28:40
robert
AW: mit strB=Inputbox("Name") ? 0wT
30.05.2009 16:41:04
Werner
Hallo robert,
mit strB wird der Name, der in der Zelle steht als Tabellenname verwendet und mit diesen gespeichert.
Wenn dieser Name schon vorhanden ist kommt die MsgBox mit der Info.
Gruß Werner
neuer name durch inputbox...
30.05.2009 16:52:06
robert
hi,
du willst doch, wenn der name schon vorhanden ist, einen neuen namen vergeben-oder?
wenn ja- dann durch die inputbox-oder?
oder willst du ganz was anderes...
gruß
robert
AW: neuer name durch inputbox...
30.05.2009 17:04:33
Werner
Hallo robert,
das ist Super, aber wie kann ich das mit einbauen.
Ich vermute das es vom gesamtmakro in den Bereich.....
strB = ActiveSheet.Cells(2, 2) ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
eingebaut werden muß, doch wie müsste ich das machen?
gruß werner
Anzeige
AW: neuer name durch inputbox...
30.05.2009 17:16:16
robert
hi,
ja , nach "weise hin.." einfügen
strB = ActiveSheet.Cells(2, 2) ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
strB=inputbox("Neuer Name") 'da Name schon vorhanden, neuen Namen eingeben
so sollte es gehen
gruß
robert
AW: neuer name durch inputbox...
30.05.2009 18:58:37
Werner
hallo robert,
ich kann jetzt zwar einen neuen Namen eingeben, der wird aber nicht angenommen ( d.h. wenn ich einen neuen Namen eingebe und auf OK gehe wird das Tabellenblatt wieder unter "Tabelle1"gespeichert.
gruß werner
Anzeige
bitte gesamten code nochmals schicken..
30.05.2009 19:13:34
robert
..ersetze..
30.05.2009 19:32:11
robert
strB=Inputbox("Neuer Name")
durch
ActiveSheet.Name=Inputbox("Neuer Name")
gruß
robert
AW: ..ersetze..
30.05.2009 19:53:39
Werner
hallo robert,
ich habe schon etwas probiert und bin auf folgendes Ergebnis gekommen.
strB = ActiveSheet.Cells(2, 2) ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
strB = InputBox("Name") 'da Name schon vorhanden, neuen Namen eingeben
ActiveSheet.Name = strB
ActiveSheet.Cells(2, 2) = strB
Workbooks("Mitarbeiterablage.xls").Close True ' Mitarbeiterablage speichern + schließen
Else
ActiveSheet.Name = strB
ActiveSheet.Cells(2, 2) = strB
Workbooks("Mitarbeiterablage.xls").Close True
so klappt es wunderbar , bis auf einen kleinen "Wurm" :-) Wenn ich den neuen Namen eingebe wird dieser übernommen, jedoch für den Fall das der Namen den ich erneut eingebe auch schon vorhanden ist
kommt eine Fehlermeldung, diese Fehlermeldung möchte ich damit abfangen, indem die InputBox mit der Meldug "auch diesere Name ist schon vorhanden" kommt und ich erneut einen Namen eingeben kann.
gruß werner
Anzeige
AW: ..ersetze..
30.05.2009 20:19:20
robert
ändere diese zeilen
" war bereits vorhanden.", vbExclamation, "weise hin..."
10
ActiveSheet.Name = InputBox("Name") 'da Name schon vorhanden, neuen Namen eingeben
If strb = InputBox("Name") Then GoTo 10
wenn name schon vorhanden, kommst du von der inputbox nicht weg,
bis du einen korrekten namen eingegeben hast.
ist vielleicht nicht die beste lösung, aber ich kann es nicht anders, aber es funktioniert.
gruß
robert
AW: ..ersetze..
30.05.2009 21:58:06
Werner
hallo robert,
strB = ActiveSheet.Cells(2, 2) ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
10
ActiveSheet.Name = InputBox("Neuer Name") 'da Name schon vorhanden, neuen Namen eingeben
If strB = InputBox("Name") Then GoTo 10
strB = InputBox("Neuer Name") 'da Name schon vorhanden, neuen Namen eingeben
ActiveSheet.Name = strB
ActiveSheet.Cells(2, 2) = strB
Workbooks("Mitarbeiterablage.xls").Close True ' Mitarbeiterablage speichern + schließen
Else
ActiveSheet.Name = strB
ActiveSheet.Cells(2, 2) = strB
Workbooks("Mitarbeiterablage.xls").Close True
ich weis nicht was ich falsch gemacht habe,den ich erhalte einen laufzeitfehler 1004
gruß werner
Anzeige
wo tritt der fehler auf?..
31.05.2009 18:56:10
robert
hi,
du hast doch gepostet, dass es geht, bis auf den namen-wenn schon vorhanden.
bei welcher zeile tritt nun der fehler auf?
kannst du die datei schicken?
gruß
robert
AW: wo tritt der fehler auf?..
31.05.2009 19:35:43
Werner
Hallo robert,
Wenn ich einen Namen eingebe der schon vorhanden ist, taucht die Fehlermeldung auf, und dabei wird der Bereich bzw. die Zeil ActiveSheet.Name = strB wird gelb hinterlegt.
https://www.herber.de/bbs/user/62134.xls
gruß werner
Sorry,zu komplex f.meinen Level..
31.05.2009 20:02:40
robert
hi,
tut mir leid, siehe betreff und ausserdem bin ich schon in Bibione :-)
stelle die frage auf offen, hilfe wird sicher kommen
gruß
robert
Anzeige
AW: Sorry,zu komplex f.meinen Level..
31.05.2009 20:04:26
Werner
hallo robert,
schönen Urlaub :-) :-)
gruß werner
Fehlerbehandlung
31.05.2009 23:17:59
Ramses
Hallo
Deine Fehlerbehandlung ist "insuffizient",... um es mal höflich auszudrücken :-)
Mit "Resume Weiter" kommt er in eine Schleife und der Fehler tritt immer wieder auf.
Wenn schon, muss die Fehlerbehandlung dieses auch abfangen
Anstelle von
fehler:
Resume weiter
solltest du zumindest sowas verwenden
fehler:
Select Case Err
Case 1004
msgbox "Eine Tabelle mit diesem Namen existiert schon", vbCritical+vbokonly,"Fehler"
Exit sub
Case else
msgbox err.number & ": " & Err.Description
Exit sub
End Select
End Sub
Gruss Rainer
Anzeige
AW: Bitte um Hilfe !!
03.06.2009 20:56:15
Werner
Hallo Rainer,
mir fehlt mal wieder der Durchblick!!
Das Ursprüngliche Mackro hatte gut funktioniert.

Public Function SheetTest(strName As String) As Boolean
On Error Resume Next
SheetTest = Not Sheets(strName) Is Nothing
End Function




Private Sub CommandButtonTabelle2_Click()
Dim vLinks, ii As Integer, strB As String
Dim lstrFile As String, liLW As Integer
Application.EnableEvents = False
On Error GoTo fehler:
For liLW = 67 To 90
If Dir(Chr(liLW) & ":Mitarbeiterablage.xls")  "" _
Then
lstrFile = Chr(liLW) & ":Mitarbeiterablage.xls" _
On Error GoTo 0
Exit For
weiter:
End If
Next
If lstrFile = "" Then
MsgBox "Auf keinem der Laufwerke von C: - Z: existiert eine Datei mit dem Namen '' _
Mitarbeiterablage.xls ''" & vbCrLf & "oder das Verzeichnis ''\Kalkulation-Kostenrechnung-Rö _
merbad'' ist nicht vorhanden", vbExclamation, "Hinweis"
Exit Sub
End If
Workbooks.Open Filename:=lstrFile
Windows("KalkulationKostenrechnungRömerbad25_08_2008.xls").Activate
Sheets("Tabelle2").Select
Sheets("Tabelle2").Copy after:=Workbooks("Mitarbeiterablage.xls").Sheets(1)
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Shapes("CommandButtonMA2").Left = Range("F1").Left  'CommandButton Positionieren
ActiveSheet.Shapes("CommandButtonMA2").Top = Range("F1").Top
strB = ActiveSheet.Cells(2, 2)   ' Blatt umbenennen
If SheetTest(strB) Then
MsgBox "Das kopierte Blatt konnte in " & ActiveWorkbook.Name & _
" nicht umbenannt werden." & vbLf & vbLf & "Blatt '" & strB & _
" war bereits vorhanden.", vbExclamation, "weise hin..."
Workbooks("Mitarbeiterablage.xls").Close True      ' Mitarbeiterablage speichern + schließen
Else
ActiveSheet.Name = strB
Workbooks("Mitarbeiterablage.xls").Close True
End If
Windows("KalkulationKostenrechnungRömerbad25_08_2008.xls").Activate
Sheets("Tabelle2").Select
Sheets("Tabelle2").Range("B3,B4,B5,E2,E3,K9:O47,G10:I10,E15:G18,J14,V11:V22,AA11:AC22,P14:P17"). _
_
ClearContents
Range("A6") = 2
Range("A7") = 1
Sheets("Startcenter").Range("D13") = "Mitarbeiter 2"
Exit Sub
fehler:
Resume weiter
Application.EnableEvents = True
End Sub


Es geht um den Bereich ' Blatt umbenennen
Wenn der Name schon vorhanden ist soll eine InputBox erscheinen in der ich einen neuen namen eingeben kann (bis dahin hatte ich schon Hilfe, konnte sie aber nicht richtig umsetzen).
Wenn ich einen Namen eingebe , der auch schon vorhanden ist soll, soll die InputBox erhalten bleiben bzw. der name wieder gelöscht werden bis ich einen Namen eingebe, der noch nicht vorhanden ist, erst dann soll das Makro weiter gehen....
ich hoffe es kann mir geholfen werden.
Gruß Werner

Anzeige

Links zu Excel-Dialogen

CommandButton InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige