Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Beim Kopieren immer nur Werte einfügen
zurück: Bedingte Formatierung auslesen weiter: Klassenprogrammierung: Factory-Klasse Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Information Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Isabelle :-)
Menschin


Verfasst am:
19. Feb 2014, 01:59
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


Beim Kopieren immer nur Werte einfügen - Beim Kopieren immer nur Werte einfügen

Nach oben
       Version: Office 2k (2000)

Hallöchen,

weil das immer wieder mal gefragt wird, hier eine mögliche Lösung.

Dabei wird, wenn die Mappe das Vordergrundfenster ist, alle 300 Millisekunden geprüft, ob sich Excelzellen oder HTML-Code im Clipboard befinden. Wenn ja, wird der reine Text ausgelesen, der Inhalt des Clipboards gelöscht und der reine Text wider in das Clipboard zurückgeschrieben. Dass dabei der Ameisenrahmen um die kopierten Zellen verloren geht ist leider nicht zu verhindern. Und es ist nicht möglich aus der Mappe formatierte Zellen in eine andere Mappe zu kopieren.

Mit einer zusätzlichen Abfrage in der Prozedur "RunTimer" könnte das Ganze auch auf eine einzelne Tabelle (Beispiel: If ActiveSheet Is Tabelle1 Then) werden.

In das Modul "DieseArbeitsmappe":

Code:
Option Explicit

Private Sub Workbook_Activate()
    Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not Saved Then
        Select Case MsgBox("Sollen Ihre Änderungen in '" & Name & _
            "' gespeichert werden", vbExclamation Or vbYesNoCancel)
            Case vbYes
                Save
            Case vbNo
                Saved = True
            Case vbCancel
                Cancel = True
        End Select
    End If
    If Not Cancel Then Call StopTimer
End Sub

Private Sub Workbook_Deactivate()
    Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Open()
    Call StartTimer
End Sub


In ein Standardmodul (basTimer):

Code:
Option Explicit
Option Private Module

Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Public Sub StartTimer()

    'Timer der alle 300 Millisekunden die Prozedur RunTimer aufruft
    Call SetTimer(Application.hWnd, 0&, 300&, AddressOf RunTimer)

End Sub

Private Function RunTimer(ByVal pvlngHwnd As Long, ByVal pvlngEventID As Long, _
    ByVal pvlngElapse As Long, ByVal pvlngTimerFunction As Long)

    'Wenn das Vordergrundfenster Excel und die aktive Mappe darin diese Mappe ist
    'dann prüfe ob sich Excelzellen oder HTML im Clipboard befinden
    If GetForegroundWindow = Application.hWnd Then _
        If ActiveWorkbook Is ThisWorkbook Then Call RequestClipBoard

End Function

Public Sub StopTimer()

    'Timer abbrechen
    Call KillTimer(Application.hWnd, 0&)

End Sub


In ein Standardmodul (basClipBoard)

Code:
Option Explicit
Option Private Module

Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
    ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" ( _
    ByVal hMem As Long) As Long
Private Declare Function lstrlenA Lib "kernel32.dll" ( _
    ByVal lpString As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32.dll" ( _
    ByVal lpString1 As Any, _
    ByVal lpString2 As Any) 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 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 EnumClipboardFormats Lib "user32.dll" ( _
    ByVal uFormat As Long) As Long
Private Declare Function GetClipboardFormatNameW Lib "user32.dll" ( _
    ByVal uFormat As Long, _
    ByVal lpString As Long, _
    ByVal nMaxCount As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hWnd As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _
    ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long

Private Const GCF_HTML_FORMAT As String = "HTML Format"
Private Const GCF_BIFF_FORMAT As String = "Biff8"

Private Const CF_TEXT As Long = 1&

Private Const GMEM_MOVEABLE As Long = &H2&

Public Sub RequestClipBoard()

    Dim strText As String

    'Prüfen ob ein HTML-Format oder ein BIFF-Format im Clipboard ist
    If ParseClipBoard Then

        'Prüfen ob Text im Clipboard ist
        If IsClipboardFormatAvailable(CF_TEXT) <> 0 Then

            'Text aus dem Clipboard lesen
            strText = TextFromClipboard

            'Text in das Clipboard schreiben
            If strText <> vbNullString Then Call TextToClipboard(strText)

        End If
    End If
End Sub

Private Function ParseClipBoard() As Boolean

    Static slngClipboardFormatHtml As Long
    Static slngClipboardFormatBiff As Long

    'Prüfen ob das Clipboard zu öffnen ist
    If OpenClipboard(Application.hWnd) <> 0 Then

        'Nummer des HTML-Formates ermitteln
        If slngClipboardFormatHtml = 0 Then _
            slngClipboardFormatHtml = GetClipboarFormat(GCF_HTML_FORMAT)

        'Nummer des BIFF-Formates ermitteln
        If slngClipboardFormatBiff = 0 Then _
            slngClipboardFormatBiff = GetClipboarFormat(GCF_BIFF_FORMAT)

        'Prüfen ob das gesuchte Format im Clipboard verfügbar ist
        'und Erfolg an aufrufender Prozedur zurückgeben
        ParseClipBoard = IsClipboardFormatAvailable(slngClipboardFormatHtml) <> 0 Or _
            IsClipboardFormatAvailable(slngClipboardFormatBiff) <> 0

    End If

    'Clipboard schließen
    Call CloseClipboard

End Function

Private Function GetClipboarFormat(ByVal pvstrClipboardFormat As String) As Long

    Dim strFormatName As String
    Dim lngReturn As Long, lngFormat As Long

    'Erste Formatnummer lesen
    lngFormat = EnumClipboardFormats(0)

    'Bis keine Nummer mehr gefunden wird
    Do Until lngFormat = 0

        'Puffer für Namen des Formates anlegen
        strFormatName = Space$(260)

        'Formatnamen der Nummer lesen und dessen Länge ermitteln
        lngReturn = GetClipboardFormatNameW(lngFormat, StrPtr(strFormatName), Len(strFormatName))

        'Wenn das HTML-Format gefunden wurde
        If Left$(strFormatName, lngReturn) = pvstrClipboardFormat Then

            'Nummer des Formates an die aufrufende Prozedur zurück geben
            GetClipboarFormat = lngFormat
            Exit Do

        End If

        'Nächste Formatnummer lesen
        lngFormat = EnumClipboardFormats(lngFormat)

    Loop
End Function

Private Function TextFromClipboard() As String

    Dim lngClipboardHandle As Long, lngLockPointer As Long
    Dim strText As String

    'Prüfen ob das Clipboard zu öffnen ist
    If OpenClipboard(Application.hWnd) <> 0 Then

        'Zugriffsnummer des Textformates im Clipboard lesen
        lngClipboardHandle = GetClipboardData(CF_TEXT)

        'Speicherbereich gegen Änderung sperren und dabei die Speicheradresse lesen
        lngLockPointer = GlobalLock(lngClipboardHandle)

        'Puffer für den Text erstellen
        strText = Space$(lstrlenA(ByVal lngLockPointer))

        'Text in den Puffer kopieren
        Call lstrcpyA(strText, ByVal lngLockPointer)

        'Speichersperre aufheben
        Call GlobalUnlock(lngClipboardHandle)

        'Clipboard schließen
        Call CloseClipboard

        'Text aus dem ClpBaord an die aufrufende Prozedur zurückgeben
        TextFromClipboard = strText

    End If
End Function

Private Sub TextToClipboard(ByVal pvstrText As String)

    Dim lngMemoryPointer As Long, lngLockPointer As Long

    'Im Heap Platz für den Text reservieren und dabei die Adresse lesen
    lngMemoryPointer = GlobalAlloc(GMEM_MOVEABLE, Len(pvstrText) + 1)

    'Speicherbereich gegen Änderung sperren und dabei die Speicheradresse lesen
    lngLockPointer = GlobalLock(lngMemoryPointer)

    'Kopiere den Text in den Speicher
    Call lstrcpyA(ByVal lngLockPointer, pvstrText)

    'Reservierung im Heap freigeben
    Call GlobalUnlock(lngMemoryPointer)

    'Prüfen ob das Clipboard zu öffnen ist
    If OpenClipboard(Application.hWnd) <> 0 Then

        'Inhalt im Clipboard löschen
        Call EmptyClipboard

        'Neuen Inalt aus dem Heap in das Clipboard kopieren
        Call SetClipboardData(CF_TEXT, lngMemoryPointer)

        'Clipboard schließen
        Call CloseClipboard

    End If

    'Heap freigeben
    Call GlobalFree(lngMemoryPointer)

End Sub

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Text von Tabelle1 auch in Tabelle 2 kopieren 7 Pinguin1977 2848 30. Jan 2005, 16:56
Pinguin1977 Text von Tabelle1 auch in Tabelle 2 kopieren
Keine neuen Beiträge Excel Formeln: Werte aus Projekttabelle 1 automatisch in Tabelle 2 + 3 ? 7 DerDoktor 3771 15. Jan 2005, 14:41
DerDoktor Werte aus Projekttabelle 1 automatisch in Tabelle 2 + 3 ?
Keine neuen Beiträge Excel Formeln: Will Werte addieren in Bezug zu einer anderen Spalte 8 MrMr 2236 08. Jan 2005, 14:50
xyzdef Will Werte addieren in Bezug zu einer anderen Spalte
Keine neuen Beiträge Excel Formeln: Zellinhalte KOPIEREN 5 hilfloses Wesen 1732 23. Dez 2004, 13:42
Gast Zellinhalte KOPIEREN
Keine neuen Beiträge Excel Formeln: Formel mit "festem" Wert kopieren 2 sebbi 1937 08. Dez 2004, 20:36
sebbi Formel mit "festem" Wert kopieren
Keine neuen Beiträge Excel Formeln: Anzahl identischer Werte 2 Toledo 2627 04. Dez 2004, 01:19
Toledo Anzahl identischer Werte
Keine neuen Beiträge Excel Formeln: Werte aus bestimmten Bereich anzeigen 3 timo 2343 27. Okt 2004, 12:56
fridgenep Werte aus bestimmten Bereich anzeigen
Keine neuen Beiträge Excel Formeln: Formel als Text in Nachbarzelle kopieren 6 blauvogel 1129 19. Okt 2004, 16:54
blauvogel Formel als Text in Nachbarzelle kopieren
Keine neuen Beiträge Excel Formeln: In Exel gleiche Zeilen finden und andere Werte importieren 0 Timo 3157 13. Okt 2004, 14:46
Timo In Exel gleiche Zeilen finden und andere Werte importieren
Keine neuen Beiträge Excel Formeln: erste Zeichen einer Zelle in andere kopieren 2 fisler0815 3067 11. Okt 2004, 15:37
fisler0815 erste Zeichen einer Zelle in andere kopieren
Keine neuen Beiträge Excel Formeln: Namen mit HLOOKUP (VERWEIS) in ein anderes Sheet einfügen 2 Aloha 917 03. Okt 2004, 08:08
Aloha Namen mit HLOOKUP (VERWEIS) in ein anderes Sheet einfügen
Keine neuen Beiträge Excel Formeln: Hyperlink per VBA kopieren 1 Gast 1118 03. Aug 2004, 16:57
ae Hyperlink per VBA kopieren
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Excel-Formeln