Supportnet / Forum / Tabellenkalkulation
Abfrage ob zelle Leer
Frage
Hallo,
ich habe leider wieder für die Profis unter euch wahrscheinlich ein kleines Problem.
Ich habe eine Tabelle wo verschiedene eingaben gemacht werden müßen, wenn alle eingaben gemacht sind wird über einen Button der Speicher vorgang eingeleitet, ist es möglich bevor das Makro für das Abspeichern läuft eine abfrage zu Starten ob bestimmte Zellen einen Wert haben wenn nicht soll ein Fenster kommen mit einer Meldung ( z.B. Zelle C1 und g100 muß noch ausgefüllt werden ) der Speichervorgang soll nartürlich dann Abgebrochen werden.
Gruß und schönen Sonntag
Achim
Antwort 1 von Event
Hallo
Das ist natürlich prinzipiell möglich, aber ohne Kenntniss Deiner Pflichtzellen nicht zu realisiseren.
Gut wär´s auch, wenn Du Dein Speicher-Makro posten würdest, denn das wäre dann zu modifizieren.
Gruß
Das ist natürlich prinzipiell möglich, aber ohne Kenntniss Deiner Pflichtzellen nicht zu realisiseren.
Gut wär´s auch, wenn Du Dein Speicher-Makro posten würdest, denn das wäre dann zu modifizieren.
Gruß
Antwort 2 von achim115
Hallo Event,
erst mal Danke für die schnelle Antwort.
Die Zellen die abgefragt werden sollen lauten wie folgt:
B44;C44;D44;B45;F44.
Die Zellen befinden sich alle in der Mappe Test3
Nachfolgend das Makro für das Speichern.
Sub Kopieren()
Dim Wiederholungen As Integer, Quelldatei As String, i As Integer, _
Neuer_Dateiname
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
Workbooks.Add
For Wiederholungen = 1 To 3
Sheets(Wiederholungen).Name = Workbooks(Quelldatei).Sheets(Wiederholungen).Name
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
i = MsgBox("SpeichernAktion kann nicht rückgängig gemacht werden!" & Chr(13) & _
"" & Chr(13) & _
"Sicher? Dann OK, sonst ABBRECHEN" & Chr(13), 1 + vbExclamation, "Festwerte in neue Datei speichern")
Rem wenn Abbrechen angeklickt, makroende
If i = 2 Then Exit Sub
Rem SpeichernDialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=Range("r1") & ".xls", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Range("r1") & ".xls"
Sheets("Test1").Select
Range("h1").Select
Sheets("Test2").Select
Columns("o:P").Select
Selection.Clear
Range("n1").Select
Sheets("Test3").Select
Columns("H:I").Select
Selection.Clear
Range("H1").Select
End Sub
Gruß
Achim
erst mal Danke für die schnelle Antwort.
Die Zellen die abgefragt werden sollen lauten wie folgt:
B44;C44;D44;B45;F44.
Die Zellen befinden sich alle in der Mappe Test3
Nachfolgend das Makro für das Speichern.
Sub Kopieren()
Dim Wiederholungen As Integer, Quelldatei As String, i As Integer, _
Neuer_Dateiname
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
Workbooks.Add
For Wiederholungen = 1 To 3
Sheets(Wiederholungen).Name = Workbooks(Quelldatei).Sheets(Wiederholungen).Name
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
i = MsgBox("SpeichernAktion kann nicht rückgängig gemacht werden!" & Chr(13) & _
"" & Chr(13) & _
"Sicher? Dann OK, sonst ABBRECHEN" & Chr(13), 1 + vbExclamation, "Festwerte in neue Datei speichern")
Rem wenn Abbrechen angeklickt, makroende
If i = 2 Then Exit Sub
Rem SpeichernDialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=Range("r1") & ".xls", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Range("r1") & ".xls"
Sheets("Test1").Select
Range("h1").Select
Sheets("Test2").Select
Columns("o:P").Select
Selection.Clear
Range("n1").Select
Sheets("Test3").Select
Columns("H:I").Select
Selection.Clear
Range("H1").Select
End Sub
Gruß
Achim
Antwort 3 von Event
Hallo Achim
Versuch´s mal so:
Bin davon ausgegangen Du meintest Tabellenblatt "Test3" und nicht Mappe.
Gruß
Versuch´s mal so:
Sub Kopieren()
Dim Wiederholungen As Integer, Quelldatei As String, i As Integer, _
Neuer_Dateiname
If sheets("Test3").Range("B44") = "" Then MsgBox ("Zelle B44 ist leer!"): Exit Sub
If sheets("Test3").Range("C44") = "" Then MsgBox ("Zelle C44 ist leer!"): Exit Sub
If sheets("Test3").Range("D44") = "" Then MsgBox ("Zelle D44 ist leer!"): Exit Sub
If sheets("Test3").Range("B45") = "" Then MsgBox ("Zelle F45 ist leer!"): Exit Sub
If sheets("Test3").Range("F44") = "" Then MsgBox ("Zelle F44 ist leer!"): Exit Sub
Application.ScreenUpdating = False
Quelldatei = ActiveWorkbook.Name
Workbooks.Add
For Wiederholungen = 1 To 3
Sheets(Wiederholungen).Name = Workbooks(Quelldatei).Sheets(Wiederholungen).Name
Workbooks(Quelldatei).Sheets(Wiederholungen).Cells.Copy
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets(Wiederholungen).Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
i = MsgBox("SpeichernAktion kann nicht rückgängig gemacht werden!" & Chr(13) & _
"" & Chr(13) & _
"Sicher? Dann OK, sonst ABBRECHEN" & Chr(13), 1 + vbExclamation, "Festwerte in neue Datei speichern")
Rem wenn Abbrechen angeklickt, makroende
If i = 2 Then Exit Sub
Rem SpeichernDialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=Range("r1") & ".xls", fileFilter:="Excel-Arbeitsmappe, *.xls")
If Neuer_Dateiname = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=Range("r1") & ".xls"
Sheets("Test1").Select
Range("h1").Select
Sheets("Test2").Select
Columns("o:P").Select
Selection.Clear
Range("n1").Select
Sheets("Test3").Select
Columns("H:I").Select
Selection.Clear
Range("H1").Select
End Sub
Bin davon ausgegangen Du meintest Tabellenblatt "Test3" und nicht Mappe.
Gruß
Antwort 4 von achim115
Hallo Event,
Erst mal vielen Danke für die hilfe, es funktioniert.
Ich meinte nartürliche Tabellenblatt und nicht Mappe war ein fehler meiner seits.
Gruß und schönen Abend
Achim
Erst mal vielen Danke für die hilfe, es funktioniert.
Ich meinte nartürliche Tabellenblatt und nicht Mappe war ein fehler meiner seits.
Gruß und schönen Abend
Achim