|
Hallo Sonja,
das läßt sich m.E. nicht so einfach verhindern. Ich kenne keine Methode.
Leider bietet Excel kein BeforeInsert-Event...
Dann könnte man die Zwischenablage auf unerwünschte Formate abklopfen und Dein Wunsch wäre erfüllt.
Leider bietet Excel auch kein AfterInsert-Event...
Dann könnte man den eingefügten Inhalt bei Bedarf rückgängig machen oder in einer Schleife alle Objekte ermitteln und ggf. löschen.
Das Change-Event dagegen spricht nur auf Zelleninhalte an, reicht also auch nicht.
Außerdem stellt sich mir die Frage, ob ggf. überhaupt nur unformatierter Text eingefügt werden soll oder ob formatierter Text erlaubt ist...
Als Trigger könnte man ggf. das Activate-Event nehmen, dann werden aber nur Inhalte von anderen Blättern gecheckt. Einfügen aus anderen Anwendungen funktioniert dagegen wieder.
Bliebe also nur eine Timerlösung. Die aber frißt zu viel Ressourcen um ein eher seltenes Phänomem abzufangen.
Hier mal eine andere Idee. Noch recht frisch und ohne Gewähr. Müsste also mal ausgiebig getestet werden.
So funktioniert es:
Die Sub KopiereClipboardAlsText checkt den Inhalt der Zwischenablage.
Enthaltener formatierter Text wird durch unformatierten Text innerhalb der Zwischenbalage ersetzt, bei anderen Inhalten wird die Zwischenablage geleert.
Auf eine mögliche temporäre MsgBox habe ich verzichtet, der User merkt schon, dass da nichts zu machen ist.
Damit auch Einfügungen aus anderen Anwendungen geblockt werden, reicht Worksheet/book-Activate nicht aus. Hier muss eine Eventhookinglösung her...
Hinweis: Bevor anderer Code läuft, sollte das Eventhooking für diese abgeschaltet werden...
Probiere es halt mal aus, vielleicht bringt es ja was.
Code:
001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111 |
|
' ### In ein normales Modul ###
Option Explicit
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 GlobalSize 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 lstrcpy Lib "kernel32" ( _
ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" ( _
ByVal wFormat As Long) As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" ( _
ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" ( _
ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetWinEventHook Lib "user32" ( _
ByVal eventMin As Long, ByVal eventMax As Long, _
ByVal hmodWinEventProc As LongPtr, _
ByVal lpfnWinEventProc As LongPtr, ByVal idProcess As Long, _
ByVal idThread As Long, ByVal dwflags As Long) As LongPtr
Private Declare PtrSafe Function UnhookWinEvent Lib "user32" ( _
ByVal hWinEventHook As LongPtr) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Dim mhEventHook As LongPtr ' Handle des Eventhooking
Public Sub StartZACheck()
Call KopiereClipboardAlsText
If mhEventHook = 0 Then
mhEventHook = SetWinEventHook(3, 3, 0, AddressOf EventProc, 0, 0, 0)
End If
End Sub
Public Sub StopZACheck() ' Beendet den Eventhook
If mhEventHook <> 0 Then UnhookWinEvent mhEventHook: mhEventHook = 0
End Sub
Private Function EventProc(ByVal hWinEventHook As LongPtr, ByVal WinEvent As Long, _
ByVal hwnd As LongPtr, ByVal idObject As Long, _
ByVal idChild As Long, ByVal dwEventThread As Long, _
ByVal dwmsEventTime As Long) As Long
If hwnd = Application.hwnd Then Call KopiereClipboardAlsText
End Function
Private Sub KopiereClipboardAlsText()
' Kopiert Zwischenablageinhalt als Text oder löscht Grafiken
Dim hMem As LongPtr, lpGMem As LongPtr, sCliptext As String, i As Long
Const CF_TEXT As Long = 1
Const CF_BITMAP As Long = 2
If IsClipboardFormatAvailable(CF_BITMAP) > 0 Then ' Daten vorhanden?
For i = 1 To 2
OpenClipboard 0& ' Zwischenablage öffnen
If i = 1 Then
hMem = GetClipboardData(CF_TEXT) ' TEXT aus Zwischenablage
If hMem = 0 Then ' Kein Text
Application.StatusBar = "Objekte einfügen ist nicht erlaubt!!!"
Call EmptyClipboard ' Zwischenablage leeren
Call CloseClipboard: Exit Sub ' Zwischenablage schließen
End If
Else
hMem = GlobalAlloc(&H42, Len(sCliptext)) ' Speicher reservieren
End If
If hMem > 0 Then
lpGMem = GlobalLock(hMem) ' Speicher blockieren
If i = 1 Then
sCliptext = Space(CLng(GlobalSize(hMem))) ' Platz reservieren
lstrcpy sCliptext, lpGMem ' Daten kopieren
GlobalUnlock hMem ' Speicher freigeben
EmptyClipboard ' Zwischenablage leeren
Else
lpGMem = lstrcpy(lpGMem, sCliptext) ' Daten kopieren
If GlobalUnlock(hMem) = 0 Then _
SetClipboardData CF_TEXT, hMem ' TEXT in Zwischenablage
End If
End If
CloseClipboard ' Zwischenablage schließen
Next i
End If
End Sub
' ### In das/die gewünschte(n) Tabellenblattmodul(e) ###
Private Sub Worksheet_Activate()
Call StartZACheck
End Sub
Private Sub Worksheet_Deactivate()
Call StopZACheck
End Sub
' ### In das DieseArbeitsmappemodul ###
Private Sub Workbook_Open()
If ActiveSheet.Name = "Tabelle1" Then
Call StartZACheck
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopZACheck
End Sub
|
_________
viele Grüße
Karl-Heinz
|