Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1744to1748
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
Inhaltsverzeichnis

MsgBox über Userform erstellen

MsgBox über Userform erstellen
04.03.2020 07:30:13
Ralf
Hallo zusammen,
da ich auch schon des öfteren von Euch profitiert habe, möchte ich Euch eine kleine Userform überlassen.
Mit dieser kann man sich einen Codeschnipsel für eine MsgBox erstellen, ohne alles einzeln schreiben zu müssen.
Vielleicht gibt es sowas schon, ich habe aber nichts gefunden, also, selber machen.
Ich bin kein Profi! Wenn Ihr Fehler oder Optimierungsbedarf seht, jederzeit gerne.
Ihr könnt das auch frei verwenden und abändern, jedem wie es gefällt.
https://www.herber.de/bbs/user/135595.zip
In diesem Zip ist auch ein AddIn zum Einbinden in Excel.
Viel Spaß damit.
Ralf

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MsgBox über Userform erstellen
04.03.2020 11:27:26
volti
Hallo Ralf,
eins fiel mir gleich auf:
64 Bit ist auf dem Vormarsch...
Ich persönlich habe nur noch 64-Bit-Excel auf meinem Rechner. Deine API-Funktionen für die Zwischenlage sind aber nur für 32-Bit ausgelegt.
Nach der Erweiterung auf 64-Bit wird bei mir nur ein, nämlich das erste Zeichen aus der Zwischenablage übernommen.
Deshalb hier mal der Zwischenablageteil angepasst: (32-Bit kann ich nicht testen, sollte aber gehen)
Vielleicht kannst Du es ja brauchen....
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" ( _
        ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" ( _
       ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
        ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
        ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
        ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" _
        Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
#Else
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If
Public Sub SetClipboard(sCliptext As String)
'Kopieren von Text über die API
 Dim hMem As LongPtr, lpGMem As LongPtr
 hMem = GlobalAlloc(&H42, Len(sCliptext) + 1)
 lpGMem = GlobalLock(hMem)
 lpGMem = lstrcpy(lpGMem, sCliptext)
 If GlobalUnlock(hMem) = 0 Then
  If OpenClipboard(0&) <> 0 Then
   EmptyClipboard
   SetClipboardData 1, hMem  '=CF_TEXT
   CloseClipboard
  End If
 End If
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: MsgBox über Userform erstellen
04.03.2020 11:56:37
volti
Upps, jetzt hatte ich doch glatt die Variablen-Declares 32-Bit vergessen:
Public Sub SetClipboard(sCliptext As String)
'Kopieren von Text über die API
#If VBA7 Then
 Dim hMem As LongPtr, lpGMem As LongPtr
#Else
 Dim hMem As Long, lpGMem As Long
#End If
 hMem = GlobalAlloc(&H42, Len(sCliptext) + 1)
 lpGMem = GlobalLock(hMem)
 lpGMem = lstrcpy(lpGMem, sCliptext)
 If GlobalUnlock(hMem) = 0 Then
  If OpenClipboard(0&) <> 0 Then
   EmptyClipboard
   SetClipboardData 1, hMem  '=CF_TEXT
   CloseClipboard
  End If
 End If
End Sub
viele Grüße
Karl-Heinz

Anzeige
AW: MsgBox über Userform erstellen
05.03.2020 07:04:29
Ralf
Hallo Karl-Heinz,
danke, ich werde das bei Gelegenheit mal einbauen und testen.
@alle, die sich dafür interessieren, ich habe ein Modul M03_Spielwiese integriert,
hier kann man seinen Code hineinkopieren und wenn man die VARIABLE nicht ausfüllt,
kann der Code auch gleich getestet werden. Ansonsten bei DIM den Variablen-Namen
den Ihr verwendet habt umbenennen.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige