Msgbox Erweitern

Forumthread: Msgbox Erweitern

Msgbox Erweitern

13.09.2022 08:29:22

Oraculix

Hallo liebe Experten!
In meiner Tabelle habe ich 2 Commandbuttons mit je einer Msgbox.
1. Die erste Msgbox Speichert die Datei und schließt sich von selbst nach einer kurzer meldung "Datei erfolgreich gespeichert"
2. Die Zweite zeigt mir nur die Größe der Arbeitsmappe an.(Leider in Kb und nicht in Mb)
Frage:
Wäre es möglich Aus 2 Msgboxen nur eine zu machen? Also beide Vba Codes in eine Msgbox zusammenzuführen?
Dann würde ich mir einen Commandbutton sparen.
Hier der erste Code.
'Datei Speichern Unter !FilmeDB.xlsm


Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\EMDB\HTML\!Filme.xlsm"
Application.DisplayAlerts = True
Call MessageBoxTimeoutA(Application.hwnd, "Datei erfolgreich gespeichert", _
"Information", vbInformation, 0, 1000)  'Datei Speichern Unter !FilmeDB.xlsm  'Wird automatisch geschlossen ohne Ok Butten zu klicken.'
Hier der Zweite Code:
'Zeige Datei Grösse
Sub ZeigeDateiGroesse()
MsgBox "Die Größe der aktuellen Arbeitsmappe " & _
"beträgt " & FileLen(ThisWorkbook.FullName) / 1024 & _
" KByte."  'Leider in Kb wäre super in Mb mit 2 Kommastellen
End Sub

Gruß
Oraculix

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Msgbox Erweitern

13.09.2022 08:40:59

ChrisL
AW: Msgbox Erweitern

13.09.2022 08:50:43

Oraculix
finde ich so OK...

13.09.2022 09:01:47

ChrisL
AW: Msgbox Erweitern

13.09.2022 09:05:54

volti
AW: Msgbox Erweitern

13.09.2022 09:16:47

Oraculix
Super Genial!!!! Vielen Dank Karl Heinz

13.09.2022 09:26:04

Oraculix

AW: Msgbox Erweitern

13.09.2022 08:40:59

ChrisL

Hi
Wie wärs hiermit...


Sub t()
Dim strDateipfad As String
strDateipfad = "D:\EMDB\HTML\!Filme.xlsm"
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=strDateipfad
Application.DisplayAlerts = True
MsgBox "Datei erfolgreich gespeichert" & Chr(10) & Chr(10) & _
"Die Größe der aktuellen Arbeitsmappe beträgt " & _
Round(FileLen(strDateipfad) / 1024000, 3) & " MB.", vbInformation
End Sub

cu
Chris

AW: Msgbox Erweitern

13.09.2022 08:50:43

Oraculix

Vielen Dank fast Genial!
Es Funktioniert nur leider schließt sich die Msgbox nicht von selbst. Muss immer Ok bestätigen.
Gruß
Oraculiy

finde ich so OK...

13.09.2022 09:01:47

ChrisL

Hi
Ich lasse die Frage offen.
Die einmalige Bestätigung finde ich ganz OK. Angenommen man wird im entscheidenden Moment abgelenkt oder wenn man erst die Brille aufsetzen muss, dann sieht man die Nachricht nicht. Zeitgesteuerte Nachrichten empfinde ich bis auf ganz wenige Ausnahmen nur nervig.
Natürlich Ansichtssache...
Aber ich glaube die andere Version mit MessageBoxTimeoutA (gibt es eine Funktion dazu?) überlagert die Speicherung d.h. die MsgBox erscheint, auch wenn die Speicherung vielleicht noch läuft. Insofern ist die Zuverlässigkeit der Nachricht in Frage zu stellen und zudem hast du eine Abhängigkeit zum Betriebssystem.
Nur eine Interpretation meinerseits. Ich müsste auch mal testen/recherchieren.
cu
Chris

AW: Msgbox Erweitern

13.09.2022 09:05:54

volti

Hallo,
unter Berücksichtigung von ChrisL's Aussagen mal zum Testen.

Code:


Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" ( _
        ByVal hwnd As LongPtr, _
        ByVal lpText As String, ByVal lpCation As String, _
        ByVal uType As Long, ByVal wLanguageId As Integer, _
        ByVal dwMiliseconds As Long) As Long

 Sub t()
   Dim strDateipfad As String
   Dim intMsg As Long, bytzeit As Long
   
   bytzeit = 3000
 
   strDateipfad = "D:&bsol;EMDB&bsol;HTML&bsol;!Filme.xlsm"
 
   Application.DisplayAlerts = False
   ThisWorkbook.SaveAs Filename:=strDateipfad
   Application.DisplayAlerts = True
      
   intMsg = MessageBoxTimeoutA(Application.hwnd, _
         "Datei erfolgreich gespeichert" & Chr(10) & Chr(10) & _
         "Die Größe der aktuellen Arbeitsmappe beträgt " & _
         Round(FileLen(strDateipfad) / 1024000, 3) & " MB.", _
         "Info", vbInformation, 0, bytzeit)
 End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Msgbox Erweitern

13.09.2022 09:16:47

Oraculix

Danke aber leider fehler!
Dies habe ich ganz oben im Modul eingetragen leider alles Rot und es funktioniert nicht. Habe 64 bit Version!
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal lpText As String, ByVal lpCation As String, _
ByVal uType As Long, ByVal wLanguageId As Integer, _
ByVal dwMiliseconds As Long) As LongPrivate Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal lpText As String, ByVal lpCation As String, _
ByVal uType As Long, ByVal wLanguageId As Integer, _
ByVal dwMiliseconds As Long) As Long
Gruß
Oraculix

Super Genial!!!! Vielen Dank Karl Heinz

13.09.2022 09:26:04

Oraculix

Super Genial!!!! Vielen Dank war ein kopier Fehler meiner Maus. Jetzt geht es !!!
Gruß
Oraculix

Beliebteste Forumthreads (12 Monate)

Forumthread: Msgbox Erweitern

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread