Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1844to1848
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
1844to1848
1844to1848
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Eigenartige Sache

Eigenartige Sache
07.09.2021 14:29:26
oraculix
Hallo Eigenartige Dinge passieren mit Excel
Beim klicken auf den Commandbutton5 wird die Arbeitsmappe gespeichert und danach erscheint statt einer Msgbox ein Object das 1Sekunde
automatisch geschlossen werden sollte! Tut es aber nicht es dauert fast 7 sec.
Frage:
Wie kann ich das noch beschleunigen damit die Meldung schneller geschlossen wird?
Habe schon zb. versucht 0.1 einzugeben dann wird es sogar noch länger.

Private Sub CommandButton5_Click()
Application.DisplayAlerts = False
Dim objWSH As Object
ActiveWorkbook.SaveAs Filename:="F:\!Software\OFFICE 2019\!Filme.xlsm"
Application.DisplayAlerts = True
Set objWSH = CreateObject("WScript.Shell")
objWSH.Popup "Datei erfolgreich gespeichert", 1, "Information"
Set objWSH = Nothing
End Sub
Gruß
Oraculix

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Eigenartige Sache
07.09.2021 15:21:11
Nepumuk
Hallo,
das Popup funktioniert in Excel nicht richtig. Versuch es mal so:

Option Explicit
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
ByVal lpText As String, _
ByVal lpCation As String, _
ByVal uType As VbMsgBoxStyle, _
ByVal wLanguageId As Integer, _
ByVal dwMiliseconds As Long) As Long
Private Sub CommandButton5_Click()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="F:\!Software\OFFICE 2019\!Filme.xlsm"
Application.DisplayAlerts = True
Call MessageBoxTimeoutA(Application.hWnd, "Datei erfolgreich gespeichert", _
"Information", vbInformation, 0, 1000)
End Sub
Gruß
Nepumuk
Anzeige
AW: Eigenartige Sache
07.09.2021 16:02:02
oraculix
Super Danke!
Blitzschnell geht das jetzt zu!
Habe noch ein Problem mit klick aus Image 24 in Userform1 soll Hyperlink folgen aber er geht immer zur falschen Tabelle.
habe den code gelöscht weil ja ein komplett neuer her muß weil es kein txtfeld mehr gibt!
Darf ich Dir mal die neue Mappe senden?
Danke
Gruß
Oraculix
AW: Eigenartige Sache
07.09.2021 16:06:02
Nepumuk
Hallo,
klar, aber sag mir bitte wo ich suchen soll.
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 16:14:39
oraculix
Also der Hyperlik steht in Tabelle=FilmInfo Spalte B ab B2
Zusammenfassung:
In der Userform linkes Bild Image 24 anklicken
und dann in Filminfo spalte B Link suchen finden öffnen!
Danke
Gruß
Oraculix
Anzeige
AW: Eigenartige Sache
07.09.2021 16:40:10
Nepumuk
Hallo,
teste mal:

Private Sub Image24_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ThisWorkbook
Call .FollowHyperlink(Address:=.Worksheets("FilmeAnsehen").Cells(Lst_Treffer.ListIndex + 2, 1).Hyperlinks(1).Address)
End With
End Sub
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 16:56:21
oraculix
Hallo
Leider Funktioniert es nicht.Habe es auf Filminfo ausgebessert dort ist ja die suche nach dem Link nütz nichts.

Sub Image24_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ThisWorkbook
Call .FollowHyperlink(Address:=.Worksheets("FilmInfo").Cells(Lst_Treffer.ListIndex + 2, 1).Hyperlinks(1).Address)
End With
End Sub
Vielleicht liegt es daran das ein Ähnlicher Code mit Doppelklick existiert? Dieser Code besteht bereits für der Listtbox
'Doppelklick in Listbox sucht eintrag in Tabelle Ansehen
Private 

Sub Lst_Treffer_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim OpenFile As String
Dim rngSuche As Range
Set rngSuche = Worksheets("FilmeAnsehen").Columns(1).Find(Lst_Treffer.Value, lookat:=xlPart)
If Not rngSuche Is Nothing Then
Me.Hide
Application.Goto Reference:=rngSuche
Else
MsgBox "Titel nicht gefunden"
End If
'Wenn Abrechen gewählt wird Fehler abfangen
On Error Resume Next
ThisWorkbook.FollowHyperlink rngSuche.Hyperlinks(1).Address
On Error Resume Next
If OpenFile = False Then
UserForm1.Show
Exit Sub
End If
Gruß
Oraculix
Anzeige
AW: Eigenartige Sache
07.09.2021 17:11:04
Nepumuk
Hallo,
dann so:

Private Sub Image24_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim objCell As Range
With ThisWorkbook
Set objCell = .Worksheets("FilmInfo").Columns(2).Find(What:= _
Lst_Treffer.List(Lst_Treffer.ListIndex, 1), LookIn:=xlValues, LookAt:=xlPart)
If Not objCell Is Nothing Then
Call .FollowHyperlink(Address:=objCell.Hyperlinks(1).Address)
Set objCell = Nothing
Else
Call MsgBox("Nicht gefunden.", vbExclamation, "Hinweis")
End If
End With
End Sub
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 17:19:06
oraculix
Danke der Code ist richtig es wird jetzt der Link gefunden und geöffnet.
Aber wenn ich zurr Userform1 zurück gehe kann ich in der Listbox Lst_Teffer kein Bild mehr auswählen?
Gruß
Oraculix
Anzeige
AW: Eigenartige Sache
07.09.2021 17:26:49
Nepumuk
Hallo,
so besser?

Private Sub Lst_Treffer_Click()
Const FOLDER_PATH As String = "D:\EMDB\HTML\ExcelCovers\"
Dim strFilename As String
strFilename = Dir$(PathName:=FOLDER_PATH & Lst_Treffer.List(Lst_Treffer.ListIndex, 1) & ".*")
If strFilename  vbNullString Then
Set Image24.Picture = LoadPicture(Filename:=FOLDER_PATH & strFilename)
Else
Set Image24.Picture = Nothing
End If
Repaint
End Sub
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 17:40:21
oraculix
Juhuu Danke jetzt geht alles.
Repaint das wollte ich Dich schon fragen wie man Aktualisiert.
Als Anfänger hätte ich
Unload.me
Userform1.Show
vorgeschlagen.
Ps.:Weitere Bilder umbenennen dauert noch ist rechtmühsam es fehlen noch ca. 700
Sende Sie Dir zu falls du es möchtest wenn sie fertig sind.
Gruß
Oraculix
Anzeige
AW: Eigenartige Sache
07.09.2021 17:49:15
Nepumuk
Hallo,
klar, dann funktioniert die Mappe bei mir auch. Aber komm nicht auf die Idee mir auch noch alle Filme zu schicken :-)
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 17:56:30
oraculix
Ne keine Sorge dass wären zu viel TB.
Tipp:
Mit WinX Hd Converter kannst Du alle Filme auf mp4 convertieren die haben dann nur ca 1,5Gb
und Qualiverlust nicht bemerkbar. Geht blitzschnell mit der Software und ist gratis.
Gruß
Oraculix
AW: Eigenartige Sache
07.09.2021 18:04:09
Nepumuk
Hallo,
keine Angst, ich hab noch gut 30 TB freien Platz und mein größter Film hat gerade mal 42 GB. Die meisten haben so zwischen 4 und 5 GB.
Gruß
Nepumuk
AW: Eigenartige Sache
07.09.2021 15:31:25
Daniel
Hi
also bei mir geht das mit dem schnellen schließen.
was bei kurzen Zeiten problematisch sein kann, ist das Excel hier oft mit Uhrzeit im Sekundentakt arbeitet und damit Anzeigedauer auch davon beeinflusst wird, wann genau du das auslöst.
falls das mit dem PopUp nicht wie gewünscht funktioniert, hier ein Workaround mit Userform.
1. Erstelle eine Userform mit der Hinweismeldung und ggf einen "Schließen"-Button (Code: Unload Me)
2. öffne die Userform nicht-modal
3. schließe die Userform über ein zweites Makro, welches du mit Zeitversatz aufrufst (hier gilt das mit dem Sekunden-Takt)
sieht als Code dann so aus:

Private Sub CommandButton5_Click()
'--- hier dein Speichercode
UserForm1.Show 0
Application.OnTime Now + TimeSerial(0, 0, 1), "aus"
End Sub
und in einem allgemeinen Modul

Sub aus()
Unload UserForm1
End Sub
gruß Daniel
Anzeige
AW: Eigenartige Sache
07.09.2021 16:03:30
oraculix
Danke Daniel funktioniert super!
Gruß
Oraculix

Links zu Excel-Dialogen

UserForm MessageBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige