Zwischenablage in Userform einfügen
Peter
hoffentlich kann mir jemand bei meinem Problem helfen:
Ich kopiere aus einem Excel-Tabellenblatt eine einzelne Zelle in die
Zwischenablage und möchte die Zwischenablage dann in eine Textbox
innerhalb einer Userform einfügen. Leider geht das Aufklappmenü zum
Einfügen (mit Rechtsklick) nicht innerhalb der Userform.
Die Frage ist also, wie ich die Zwischenablage in eine Textbox
hineinbekomme.
Bin sehr gespannt auf Eure Antworten.
Peter
Martin Hentrich
wrote:
>Ich kopiere aus einem Excel-Tabellenblatt eine einzelne Zelle in die
>Zwischenablage und möchte die Zwischenablage dann in eine Textbox
>innerhalb einer Userform einfügen.
Du möchtest den Text aus der Zwischenablege einfügen.
Vielleicht hilft dir:
http://www.online-excel.de/excel/singsel_vba.php?f=28
Martin
--
Eure Rede aber sei: Ja, ja; nein, nein.
Was darüber ist, das ist vom Übel.
[Mt. 5, 37]
Andreas Killer
> Ich kopiere aus einem Excel-Tabellenblatt eine einzelne Zelle in die
> Zwischenablage und möchte die Zwischenablage dann in eine Textbox
> innerhalb einer Userform einfügen. Leider geht das Aufklappmenü zum
> Einfügen (mit Rechtsklick) nicht innerhalb der Userform.
> Die Frage ist also, wie ich die Zwischenablage in eine Textbox
> hineinbekomme.
Drück Strg-V und filter die evt. Steuerzeichen (vbCr) im
Change-Ereignis raus.
Andreas.
Peter
das funktioniert ja echt so einfach, mein Problem ist, das ich diese
Excel-Datei an einige Leute weitergeben möchte, die dann auch
verschiedene Eintragungen machen und nicht alle diese
Tastenkombination STRG + V draufhaben.
Deshalb meine etwas präzisierte Frage: Ist es irgendwie möglich, dass
mit Rechtsklick auf die Textbox auch das Standard-Aufklappmenü
erscheint, in dem auch einer der Auswahlpunkte das Einfügen ist?
Gruß
Peter
Andreas Killer
> Deshalb meine etwas präzisierte Frage: Ist es irgendwie möglich, dass
> mit Rechtsklick auf die Textbox auch das Standard-Aufklappmenü
> erscheint, in dem auch einer der Auswahlpunkte das Einfügen ist?
Möglich schon, nur habe ich dafür leider nichts fertiges.
Du müsstest eine 2te Userform einbauen die das Rechts-Klick-Menü
darstellt und diese dann via dem MouseDown-Ereignis der Textbox
aufrufen.
Andreas.
Andreas Killer
> Deshalb meine etwas präzisierte Frage: Ist es irgendwie möglich, dass
> mit Rechtsklick auf die Textbox auch das Standard-Aufklappmenü
> erscheint, in dem auch einer der Auswahlpunkte das Einfügen ist?
Ich hab mal im Netz etwas gestöbert und auch etwas Code gefunden. Den
hab ich noch etwas "aufgebohrt" und "generalisiert", damit er leicht
und universell einsetztbar ist. Läuft bei mir unter XL2000 sowie
XL2002 wunderbar. Wie sieht's bei dir aus?
Andreas.
Attribute VB_Name = "modContextmenu"
'
'Dieses Modul ermöglicht ein Kontextmenü
' "Ausschneiden/Kopieren/Einfügen"
'für Textboxen/Comboboxen in UserForms.
'
'Der Aufruf erfolgt in der Userform im MouseUp-Ereignis:
'
'Private Sub TextBox1_MouseUp( _
' ByVal Button As Integer, ByVal Shift As Integer, _
' ByVal X As Single, ByVal Y As Single)
' If CcpMouseUp(TextBox1, Button, Shift) Then Exit Sub
' 'Sonstiger Code
'End Sub
'
'23.03.09 Andreas Killer
Option Explicit
Option Private Module
Private Const CcpMenuName = "CutCopyPaste"
Private Const CcpCutName = "A&usschneiden"
Private Const CcpCopyName = "&Kopieren"
Private Const CcpPasteName = "E&infügen"
Private CcpControl As Control 'Box aus der das Menü aufgerufen wurde
Private CcpData As Object 'Zwischenablage, Zugriff via IE
Private CcpResult As Boolean 'Useraktion erfolgt?
Public Function CcpMouseUp(ByRef C As Control, _
ByVal Button As Integer, ByVal Shift As Integer) As Boolean
'Emuliert das Rechtsklick-Kontextmenü für Eingabefelder
'True wenn der User einen Eintrag gewählt hat
Dim CcpMenubar As CommandBar, CcpItem As CommandBarControl
Dim MenuExists As Boolean
'Das Menü nur anzeigen bei Rechtsklick ohne Shift
If Button <> 2 Or Shift <> 0 Then Exit Function
'Haben wir das temporäre Menü schon erzeugt?
For Each CcpMenubar In CommandBars
If CcpMenubar.Name = CcpMenuName Then
MenuExists = True
Exit For
End If
Next
'Eine Referenz für die externen Routinen erzeugen
Set CcpControl = C
If Not MenuExists Then
'Temporäres Menü anlegen
Set CcpMenubar = CommandBars.Add(Name:=CcpMenuName, _
Position:=msoBarPopup, Temporary:=True)
CcpMenubar.Enabled = True
Set CcpItem = CommandBars(CcpMenuName).Controls.Add( _
msoControlButton)
With CcpItem
.Caption = CcpCutName
.OnAction = "CcpCut"
.FaceId = 21
End With
Set CcpItem = CommandBars(CcpMenuName).Controls.Add( _
msoControlButton)
With CcpItem
.Caption = CcpCopyName
.OnAction = "CcpCopy"
.FaceId = 19
End With
Set CcpItem = CommandBars(CcpMenuName).Controls.Add( _
msoControlButton)
With CcpItem
.Caption = CcpPasteName
.OnAction = "CcpPaste"
.FaceId = 22
End With
Else
'Ausschneiden verbieten wenn kein Text markiert
'oder Box gesperrt ist
Set CcpItem = CommandBars(CcpMenuName).Controls( _
Replace(CcpCutName, "&", ""))
CcpItem.Enabled = C.SelLength > 0 And Not C.Locked
'Kopieren verbieten wenn kein Text markiert
Set CcpItem = CommandBars(CcpMenuName).Controls( _
Replace(CcpCopyName, "&", ""))
CcpItem.Enabled = C.SelLength > 0
'Einfügen verbieten wenn kein Text in der Zwischenablage
'oder Box gesperrt ist
Set CcpItem = CommandBars(CcpMenuName).Controls( _
Replace(CcpPasteName, "&", ""))
CcpItem.Enabled = Len(GetClip) > 0 And Not C.Locked
End If
'Annehmen der User bricht ab
CcpResult = False
'Menü anzeigen
CommandBars(CcpMenuName).ShowPopup
'Hat er eine Routine aufgerufen?
CcpMouseUp = CcpResult
End Function
Private Sub CcpCut()
Dim S As String
CcpResult = True
With CcpControl
If .SelLength = 0 Then Exit Sub
S = Mid(.Value, .SelStart + 1, .SelLength)
.Value = strDelete(.Value, .SelStart + 1, _
.SelStart + .SelLength)
SetClip S
End With
End Sub
Private Sub CcpCopy()
Dim S As String
CcpResult = True
With CcpControl
If .SelLength = 0 Then Exit Sub
S = Mid(.Value, .SelStart + 1, .SelLength)
SetClip S
End With
End Sub
Private Sub CcpPaste()
Dim S As String, I As Long
CcpResult = True
With CcpControl
S = GetClip
I = .SelStart
If .SelLength > 0 Then _
.Value = strDelete(.Value, I + 1, I + .SelLength)
.Value = strInsert(.Value, S, I)
End With
End Sub
Function GetClip() As String
'Liest einen Text aus der Zwischenablage
Dim Data
If CcpData Is Nothing Then Set CcpData = CreateObject("htmlfile")
Data = CcpData.ParentWindow.ClipboardData.GetData("text")
If IsNull(Data) Then GetClip = "" Else GetClip = Data
End Function
Sub SetClip(ByVal S As Variant)
'Speichert einen Text in die Zwischenablage
If CcpData Is Nothing Then Set CcpData = CreateObject("htmlfile")
CcpData.ParentWindow.ClipboardData.SetData "text", S
End Sub
Function strInsert(ByVal S As String, ByVal SubStr As _
String, ByVal Pos As Long, Optional ByVal Before As Boolean = _
False) As String
'Fügt SubStr nach der Stelle Pos in S ein, wenn Pos negativ _
beginnt die Zählung von hinten
If Pos < 0 Then
If Abs(Pos) > Len(S) Then
Pos = -Len(S)
Before = False
End If
strInsert = Mid(S, 1, Len(S) + Pos + CDbl(Before)) & SubStr & _
Mid(S, Len(S) + Pos + 1 + CDbl(Before))
Else
If Pos = 0 Then Before = False
strInsert = Mid(S, 1, Pos + CDbl(Before)) & SubStr & Mid(S, _
Pos + 1 + CDbl(Before))
End If
End Function
Function strDelete(ByVal S As String, ByVal FromPos As _
Long, Optional ByVal ToPos As Long = 0, Optional ByVal _
Between As Boolean = False) As String
'Löscht aus S den Teil von FromPos bis ToPos, wenn Between dann _
von FromPos+1 bis ToPos-1
'Positionen korrigieren
FromPos = FromPos - CDbl(Between)
ToPos = ToPos + CDbl(Between)
If FromPos <= 0 Then FromPos = 1
'Wenn der Bereich außerhalb S liegt, S ganz zurückgeben
If FromPos > Len(S) Then
strDelete = S
Exit Function
End If
If ToPos >= Len(S) Or ToPos <= 0 Then
'Das Ende abschneiden
strDelete = Mid(S, 1, FromPos - 1)
Else
'Teilbereiche kopieren
strDelete = Mid(S, 1, FromPos - 1) & Mid(S, ToPos + 1)
End If
End Function
Peter
da hast du dir aber echt Mühe gemacht. Vielen Dank dafür.
Ich habe auch XL2000 und alles funktioniert so wie ich es mir
vorgestellt hatte.
Herzliche Grüße
Peter
Michael Schwimmer
Am Sun, 22 Mar 2009 06:46:52 -0700 (PDT) schrieb Peter:
> Ich kopiere aus einem Excel-Tabellenblatt eine einzelne Zelle in die
> Zwischenablage und möchte die Zwischenablage dann in eine Textbox
> innerhalb einer Userform einfügen. Leider geht das Aufklappmenü zum
> Einfügen (mit Rechtsklick) nicht innerhalb der Userform.
> Die Frage ist also, wie ich die Zwischenablage in eine Textbox
> hineinbekomme.
angenommen, die Userform heißt ufPopup und die Textbox auf der Userform hat
den Namen txtEinfügen.
In ein normales Modul:
Public Sub Text_Einfügen()
ufPopup.Einfügen
End Sub
Public Sub Text_Kopieren()
ufPopup.Kopieren
End Sub
In das Klassenmodul der Userform:
Option Explicit
Private mobjPopup As Object
Private Sub txtEinfügen_MouseUp( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = 2 Then mobjPopup.ShowPopup
End Sub
Private Sub UserForm_Initialize()
Dim myButton As Object
On Error Resume Next
CommandBars("NewCommandBar").Delete
Set mobjPopup = CommandBars _
.Add(Name:="NewCommandBar", _
Position:=msoBarPopup, _
Temporary:=True)
Set myButton = mobjPopup.Controls.Add
With myButton
.Style = msoButtonIconAndCaption
.FaceId = 22
.Caption = "&Einfügen"
.OnAction = "Text_Einfügen"
End With
Set myButton = mobjPopup.Controls.Add
With myButton
.Style = msoButtonIconAndCaption
.FaceId = 19
.Caption = "&Kopieren"
.OnAction = "Text_Kopieren"
End With
End Sub
Public Sub Einfügen()
' Dim objData As New DataObject
On Error Resume Next
txtEinfügen.Paste
' oder
' objData.GetFromClipboard
' If txtEinfügen.SelLength > 0 Then
' txtEinfügen.SelText = objData.GetText(1)
' Else
' txtEinfügen.Text = objData.GetText(1)
' End If
' oder
' Application.SendKeys "^V"
End Sub
Public Sub Kopieren()
' Dim objData As New DataObject
On Error Resume Next
txtEinfügen.Copy
' oder
' objData.SetText txtEinfügen.SelText
' objData.PutInClipboard
' oder
' Application.SendKeys "^C"
End Sub
Private Sub UserForm_Terminate()
mobjPopup.Delete
End Sub
Viele Grüße
Michael
--
http://michael-schwimmer.de
Masterclass Excel VBA ISBN-10: 3827325250
Das Excel-VBA Codebook ISBN-10: 3827324718
Microsoft Office Excel 2007-Programmierung ISBN-10: 3866454139
Andreas Killer
wrote:
Ich hab da mal 'ne Frage. :-)
> Public Sub Einfügen()
> ' Dim objData As New DataObject
> On Error Resume Next
>
> txtEinfügen.Paste
Jau, das ist ja viel einfacher. Jaja, das kommt davon wenn man fremden
Code blind kopiert. :-))
Aber wenn das geht, wieso geht dann eigentlich kein "if .CanUndo
then .UndoAction" ?
Das geht (unter XL2000) nur wenn ich "von Hand" einen Text eingebe.
Gibt's da etwas um das zu ermöglichen?
Andreas.
Michael Schwimmer
Am Tue, 24 Mar 2009 01:14:19 -0700 (PDT) schrieb Andreas Killer:
>> Public Sub Einfügen()
>> ' Dim objData As New DataObject
>> On Error Resume Next
>> txtEinfügen.Paste
> Jau, das ist ja viel einfacher. Jaja, das kommt davon wenn man fremden
> Code blind kopiert. :-))
> Aber wenn das geht, wieso geht dann eigentlich kein "if .CanUndo
> then .UndoAction" ?
> Das geht (unter XL2000) nur wenn ich "von Hand" einen Text eingebe.
leider sind die meisten Steuerelemente von MSForms ziemlich dumm. Wenn es
echte wären, könnte man ja noch mit SendMessage und Co arbeiten, aber man
muss sich leider mit den Eigenschaften und Methoden begnügen, die
bereitgestellt werden. Und da fehlen leider diese Eigenschaften und
Methoden.
Wie ich im Objektkatalog gesehen habe, besitzen aber die Userformen solche.
Damit können dann aber nicht gezielt Aktionen rückgängig gemacht werden,
bei mehreren Textfeldern kann das dann zum Problem werden. In dem Fall
müsste man die Change-Ereignisse der Textfelder mit Auswerten, eventuell
boolesche Variablen mitführen.
Wenn nur ein Textfeld existiert, könnte man so vorgehen:
In ein Modul:
Public Sub Text_Einfügen()
ufPopup.Einfügen
End Sub
Public Sub Text_Kopieren()
ufPopup.Kopieren
End Sub
Public Sub Text_Ausschneiden()
ufPopup.Ausschneiden
End Sub
Public Sub Text_Undo()
' ufPopup.UndoAction
ufPopup.Rückgängig
End Sub
Public Sub Text_Wiederholen()
' ufPopup.RedoAction
ufPopup.Wiederholen
End Sub
In das Klassenmodul der Userform:
Option Explicit
Private mobjPopup As Object
Private Sub txtEinfügen_MouseUp( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
With mobjPopup
.Controls(4).Enabled = False
If Me.CanUndo Then .Controls(4).Enabled = True
.Controls(5).Enabled = False
If Me.CanRedo Then .Controls(5).Enabled = True
If Button = 2 Then .ShowPopup
End With
End Sub
Private Sub UserForm_Initialize()
Dim myButton As Object
On Error Resume Next
CommandBars("NewCommandBar").Delete
Set mobjPopup = CommandBars _
.Add(Name:="NewCommandBar", _
Position:=msoBarPopup, _
Temporary:=True)
Set myButton = mobjPopup.Controls.Add(ID:=22)
myButton.OnAction = "Text_Einfügen"
Set myButton = mobjPopup.Controls.Add(ID:=19)
myButton.OnAction = "Text_Kopieren"
Set myButton = mobjPopup.Controls.Add(ID:=21)
myButton.OnAction = "Text_Ausschneiden"
Set myButton = mobjPopup.Controls.Add
With myButton
.Style = msoButtonIconAndCaption
.FaceId = 128
.Caption = "Rüc&kgängig"
.OnAction = "Text_Undo"
End With
Set myButton = mobjPopup.Controls.Add
With myButton
.Style = msoButtonIconAndCaption
.FaceId = 129
.Caption = "&Wiederholen"
.OnAction = "Text_Wiederholen"
End With
End Sub
Public Sub Einfügen()
txtEinfügen.Paste
End Sub
Public Sub Kopieren()
txtEinfügen.Copy
End Sub
Public Sub Ausschneiden()
txtEinfügen.Cut
End Sub
Public Sub Rückgängig()
Me.UndoAction
End Sub
Public Sub Wiederholen()
Me.RedoAction
Andreas Killer
>>> Public Sub Einfügen()
>>> ' Dim objData As New DataObject
>>> On Error Resume Next
>>> txtEinfügen.Paste
>> Jau, das ist ja viel einfacher. Jaja, das kommt davon wenn man fremden
>> Code blind kopiert. :-))
>> Aber wenn das geht, wieso geht dann eigentlich kein "if .CanUndo
>> then .UndoAction" ?
>> Das geht (unter XL2000) nur wenn ich "von Hand" einen Text eingebe.
> leider sind die meisten Steuerelemente von MSForms ziemlich dumm. Wenn es
> echte wären, könnte man ja noch mit SendMessage und Co arbeiten, aber man
> muss sich leider mit den Eigenschaften und Methoden begnügen, die
> bereitgestellt werden. Und da fehlen leider diese Eigenschaften und
> Methoden.
> Wie ich im Objektkatalog gesehen habe, besitzen aber die Userformen solche.
> Damit können dann aber nicht gezielt Aktionen rückgängig gemacht werden,
> bei mehreren Textfeldern kann das dann zum Problem werden. In dem Fall
..ist es besser sich selber was einfallen zu lassen. :-)
Das eine Userform nur eine Textbox hat ist wohl eher die Ausnahme,
daher favorisiere ich eine eigene Lösung.
Trotzdem vielen Dank für die Anregungen.
Andreas.