Herbers Excel-Forum - das Archiv
Zellwert mit Format in Textfeld kopieren.
Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Betrifft: Zellwert mit Format in Textfeld kopieren.
von: Maximilian
Geschrieben am: 09.10.2003 11:16:50
Hallo,
Komm leider nicht auf die Lösung wie ich einen Text (mit tiefgestellten Zeichen) in ein Textfeld samt Formatierung kopieren kann.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim objTrans As Shape
Set objTrans = ActiveSheet.Shapes("Translation")
objTrans.TextFrame.Characters.Text = ActiveCell.Value
'Vorgegebener Text
Dim objOrg As Shape
Set objOrg = ActiveSheet.Shapes("Orginal")
objOrg.TextFrame.Characters.Text = Cells(ActiveCell.Row, 2).Value & _
" " & Len(Cells(ActiveCell.Row, 2).Value)
End Sub
Aufgabe: Durch die Auswahl einer Zelle, soll der Inhalt in der zweiten Spalte vergrößert in einem Textfeld dargestellt werden. Natürlich sollten die tiefgestellten Zeichen dem Format korrekt übernommen werden. Die Veränderung der Größe dürfte kein Problem sein, da ich sie auch direkt im Textfeld vornehmen kann.
Betrifft: AW: Zellwert mit Format in Textfeld kopieren.
von: Maximilian
Geschrieben am: 09.10.2003 15:57:51
Hallo Zusammen,
habe die Lösung selber gefunden.
Hat jetzt zwar ein paar Stunden gebraucht, aber dafür kann ich heute gut schlafen. :)
Bin aber nicht böse, weil ich keine Antwort bekommen habe.
Bin immer noch davon überzeugt, dass das Forum Klasse hat.
Gruss und viel Spaß
Maximilian
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
Dim objTrans As Shape
Set objTrans = ActiveSheet.Shapes("Translation")
objTrans.TextFrame.Characters.Text = ActiveCell.Value
'Vorgegebener Text
Dim objOrg As Shape
Set objOrg = ActiveSheet.Shapes("Orginal")
objOrg.TextFrame.Characters.Text = Cells(ActiveCell.Row, 2).Value & _
" " & Len(Cells(ActiveCell.Row, 2).Value)
For i = 1 To Len(Cells(ActiveCell.Row, 2))
objOrg.TextFrame.Characters(Start:=i, Length:=1).Font.Subscript = _
ActiveSheet.Cells(ActiveCell.Row, 2).Characters(Start:=i, Length:=1).Font.Subscript
Next i
End Sub