Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
444to448
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
444to448
444to448
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

msgbox erzwingen II (@Sepp)

msgbox erzwingen II (@Sepp)
28.06.2004 15:23:28
th.heinrich
hallo Sepp und alle anderen Helfer,
ausgehen von folgendem thread
https://www.herber.de/forum/archiv/444to448/t446424.htm
folgendes prob.
Sub SaveBook() Application.DisplayAlerts = False Dim shp As Shape Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11") 'Blattname und Name des textfeldes anpassen If Len(shp.TextFrame.Characters.Text) = 0 Then MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis" Cancel = True Else ThisWorkbook.SaveAs FileName:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls" Application.DisplayAlerts = True Call auslesen End If End Sub
versuche den CODE von Sepp einzubauen, klappt leider nicht. auch wenn der DisplayAlert rausgenommen wird schliesst sich die DATEI bei leerem TEXTFELD ohne zu murren.
danke fuer Euere hilfe.
gruss thomas

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: msgbox erzwingen II (@Sepp)
Ulf

Sub SaveBook()
Application.DisplayAlerts = False
Dim shp As Shape
Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11")  'Blattname und Name des textfeldes anpassen
If Len(shp.TextFrame.Characters.Text) = 0 Then
MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis"
exit sub
Else
ThisWorkbook.SaveAs FileName:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Application.DisplayAlerts = True
Call auslesen
End If
End Sub

Ulf
Anzeige
AW: msgbox erzwingen II (@Sepp)
th.heinrich
danke Ulf,
fuer Deine schnelle hilfe leider aendert sich am verhalten der DATEI nichts, wenn ich CANCEL = TRUE durch EXIT SUB ersetze.
das BLATT ist geschuetzt, auch nach aufhebung des BLATTSCHUTZES kein erfolg.
der CODE ist einem BUTTON aus der FORMULARSYMBOLLEISTE zugeordnet.
gruss thomas
Das funktioniert einwandfrei...
Boris
Hi Thomas,
...insofern muss der Fehler (welcher überhaupt?) woanders liegen.
Grüße Boris
AW: msgbox erzwingen II (@Sepp)
Ulf
Das cancel = True macht in diesem Code überhaupt keinen Sinn.
Der Code funktioniert. Überprüf mal, ob der Name des Textfelds stimmt.
Ulf
AW: msgbox erzwingen II (@Sepp)
Josef
Hallo Thomas!
Das kann so ja nicht funktionieren!
Der Code gehört in das Modul "DieseArbeitsmappe"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
Dim shp As Shape
Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11")  'Blattname und Name des textfeldes anpassen
If Len(shp.TextFrame.Characters.Text) = 0 Then
MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis"
Cancel = True
Else
ThisWorkbook.SaveAs Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Application.DisplayAlerts = True
Call auslesen
End Sub

Die Variable "Cancel" ist in deinem Code ja gar nicht vorhanden,
bzw. währe sie ohne Wirkung.
Gruß Sepp
Anzeige
AW: msgbox erzwingen II (@Sepp)
th.heinrich
danke Sepp, Ulf und Boris,
der CODE funzzt, ich habe ihn in einer anderen TABELLE getestet. es liegt wahrscheinlich an der komplexen makroumgebung, da laufen viele sachen nacheinander ab und irgendwas scheint den CODE auszuhebeln.
im MAKRO AUSLESEN steht z.b.
ThisWorkbook.Close savechanges:=True
Application.CutCopyMode = False, aber eigentlich muesste die MSGBOX doch vorher erscheinen?
ich mach mich mal auf die suche.
danke von thomas
AW: msgbox erzwingen II (@Sepp)
Josef
Hallo Thomas!
Scheint so das sich der Code totläuft &gt Before_Close &gt Makro mit .Close &gt Before_close &gt .......
Aber ohne den ganzen Code zu kennen ist eine Diagnose bzw. Hilfe schwierig.
Gruß Sepp
Anzeige
AW: msgbox erzwingen II (@Sepp)
th.heinrich
danke Sepp fuer Dein engagement,
hier alle CODES des PROJEKTES.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
'Application.DisplayAlerts = False
Dim shp As Shape
Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11")  'Blattname und Name des textfeldes anpassen
If Len(shp.TextFrame.Characters.Text) = 0 Then
MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis"
'Cancel = True
Exit Sub
Else
ThisWorkbook.SaveAs _
Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Sheets("besuchsbericht").Protect "ni7888"
'ThisWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
End If
Call auslesen
End Sub

Sub auslesen() 'nebeneinander
'Application.ScreenUpdating = False
Dim rngAct As Range
Dim iCol As Integer
Dim lgrow As Long
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
On Error Resume Next
'Application.ScreenUpdating = False
Set wksQuell = ThisWorkbook.Sheets("Besuchsbericht")
Workbooks.Open Filename:="\\STABIFIX01\ablage\tmp\Reiseberichte\Datenbank\DB.xls"
'Windows("DB.xls").Activate
Sheets("tabelle1").Unprotect "ni7888"
Set wksZiel = ActiveWorkbook.Sheets("tabelle1")
With wksZiel
lgrow = .Range("a65536").End(xlUp).Row + 1
iCol = 1
For Each rngAct In wksQuell.Range("a4:f4,C6,d6,e6,d7,e7,d8,e8,f6:f8,e1,b11").Cells
.Cells(lgrow, iCol) = rngAct
iCol = iCol + 1
Next rngAct
End With
'ActiveWorkbook.Close savechanges:=True
ThisWorkbook.Close savechanges:=True
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs _
Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Sheets("Besuchsbericht").Protect "ni7888"
Application.DisplayAlerts = True
End Sub


Private Sub Workbook_Open()
If Range("e1").Value = "" Then Range("e1").Value = Date
Sheets("Besuchsbericht").Protect "ni7888"
End Sub

dies wird ueber den BUTTON gestartet.
Sub SaveBook()
'Application.DisplayAlerts = False
Dim shp As Shape
Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11") 'Blattname und Name des textfeldes anpassen
If Len(shp.TextFrame.Characters.Text) = 0 Then
MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis"
Cancel = True
Else
ThisWorkbook.SaveAs Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Application.DisplayAlerts = True
Call auslesen
End If
End Sub



Sub auslesen() 'nebeneinander
'Application.ScreenUpdating = False
Dim rngAct As Range
Dim iCol As Integer
Dim lgrow As Long
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
On Error Resume Next
'Application.ScreenUpdating = False
Set wksQuell = ThisWorkbook.Sheets("Besuchsbericht")
Workbooks.Open Filename:="\\STABIFIX01\ablage\tmp\Reiseberichte\Datenbank\DB.xls"
'Windows("DB.xls").Activate
Sheets("tabelle1").Unprotect "ni7888"
Set wksZiel = ActiveWorkbook.Sheets("tabelle1")
With wksZiel
lgrow = .Range("a65536").End(xlUp).Row + 1
iCol = 1
For Each rngAct In wksQuell.Range("a4:f4,C6,d6,e6,d7,e7,d8,e8,f6:f8,e1,b11").Cells
.Cells(lgrow, iCol) = rngAct
iCol = iCol + 1
Next rngAct
End With
'ActiveWorkbook.Close savechanges:=True
ThisWorkbook.Close savechanges:=True
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub
sorry ist leider sehr viel, aber Du findest Dich sicher zurecht.
gruss thomas
Anzeige
AW: msgbox erzwingen II (@Sepp)
28.06.2004 19:24:36
Josef
Hallo Thomas!
Probier mal.

' **************************************************************
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
SaveBook
Cancel = check
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs _
Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Sheets("Besuchsbericht").Protect "ni7888"
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
If Range("e1").Value = "" Then Range("e1").Value = Date
Sheets("Besuchsbericht").Protect "ni7888"
check = False
End Sub

' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************

Option Explicit
Public check As Boolean

Sub auslesen() 'nebeneinander
Dim rngAct As Range
Dim iCol As Integer
Dim lgrow As Long
Dim wksZiel As Worksheet
Dim wksQuell As Worksheet
On Error Resume Next
Set wksQuell = ThisWorkbook.Sheets("Besuchsbericht")
Workbooks.Open Filename:="\\STABIFIX01\ablage\tmp\Reiseberichte\Datenbank\DB.xls"
'Windows("DB.xls").Activate
Sheets("tabelle1").Unprotect "ni7888"
Set wksZiel = ActiveWorkbook.Sheets("tabelle1")
With wksZiel
lgrow = .Range("a65536").End(xlUp).Row + 1
iCol = 1
For Each rngAct In wksQuell.Range("a4:f4,C6,d6,e6,d7,e7,d8,e8,f6:f8,e1,b11").Cells
.Cells(lgrow, iCol) = rngAct
iCol = iCol + 1
Next rngAct
End With
Application.CutCopyMode = False
End Sub

Sub SaveBook()
Application.DisplayAlerts = False
Dim shp As Shape
Set shp = Sheets("Besuchsbericht").Shapes("Textfeld 11") 'Blattname und Name des textfeldes anpassen
check = Len(shp.TextFrame.Characters.Text) = 0
If check = True Then
MsgBox "Vor dem schliessen Besuchsinfo ausfüllen!", vbInformation, "Hinweis"
Else
ThisWorkbook.SaveAs Filename:="\\stabifix01\ablage\tmp\Reiseberichte\" & Range("b4").Value & "_" & Range("c4").Value & "_" & Range("e1").Value & ".xls"
Application.DisplayAlerts = True
Call auslesen
End If
Application.DisplayAlerts = True
End Sub

Gruß Sepp
Anzeige
AW: msgbox erzwingen II (@Sepp)
th.heinrich
tausend dank Sepp,
fuer die zeit die Du investierst. kann erst morgen in der arbeit testen, denn dort liegt das ding.
melde mich auf alle faelle nochmal.
gruss thomas
AW: msgbox erzwingen II (@Sepp)
th.heinrich
hallo Sepp,
habe Deinen CODE eingesetzt und war anfangs verwundert, dass wieder ohne MSGBOX ausgelesen wurde. dann hatte ich die glorreiche idee den inhalt der TEXTBOX zu loeschen, obwohl sie ja eigentlich leer war. aetsch war sie aber nicht, muss wohl ein LEERZEICHEN drin gewesen sein.
nun klappt alles bestens, bis auf die tatsache, dass sich excel ab und an mit
"ECXEL.EXE verursacht einen FEHLER, das programm wird geschlossen" verabschiedet.
hast Du dafuer eine erklaerung ?
nochmals herzlichen dank von thomas
Anzeige
neues problem
th.heinrich
hi Sepp,
vielleicht hast Du dafuer eine idee. die DATEI will ich als .XLT speichern, dass geht jetzt natuerlich nicht, weil das TEXTFELD leer ist.
gibt es eine moeglichkeit das MAKRO erst wirksam werden zu lassen, wenn die DATEI zur .XLS wird. einfacher wird aber sein das TEXTFELD der .XLT zu beschreibenen und dann beim oeffnen zu leeren.
danke von thomas
jetzt laeufts. TEXTFELD 11 = "" ot.
th.heinrich

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige