Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1724to1728
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

Zelleninhalt vergrößern

Zelleninhalt vergrößern
23.11.2019 12:39:49
Thomas
Moin,
im Netz habe ich einen VBA-Code zum vergrößern der aktiven Zelle gefunden. Leider bekomme ich ihn nicht so geändert, das der gesamte Zelleninhalt in dem Vergrößerungsfeld angezeigt wird. Wenn man das Vergrößerungsfeld größer zieht, vergrößert sich auch der text.
Den Text würde ich gerne eine bestimmte Größe zuweisen und im Vergrößerungsfeld soll der gesamte Text dann mit Textumbruch angezeigt werden.
Kann mir da jemand helfen?

Private Sub worksheet_selectionchange(ByVal Target As Range)
'Updateby Extendoffice
Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)
For Each xShape In ActiveSheet.Pictures
If xShape.Name = "zoom_cells" Then
xShape.Delete
End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "zoom_cells"
With .ShapeRange
.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Zelleninhalt vergrößern
26.11.2019 12:06:36
fcs
Hallo Thomas,
wenn der Text nicht ins Foto der Zelle passt, dann muss man z.B. ein Textfeld als Objekt für die Textanzeige verwenden.
Im folgenden angepassten Makro wird das Textfeld ggf. generiert. Ist die Zelle leer wird es ausgeblendet (könnte man es auch löschen). Bei Zelle mit Text wird das Textfeld in die Zelle verschoben, der Text aus der Zelle in das Textfeld übernommen und das Textfeld angezeigt. Bei viel Text wird die Höhe des Textfeldes automatisch angepasst.
Eine allternative wäre auch noch die in Windows (zumindest Vin Version 10) integrierte Lupenfunktion (via Einstellungen)
LG
Franz
Private Sub worksheet_selectionchange(ByVal Target As Range)
'Updateby Extendoffice
Dim xRg As Range
Dim xShape As Shape
Set xRg = Target.Areas(1)
Application.ScreenUpdating = False
On Error GoTo Fehler
Set xShape = ActiveSheet.Shapes("ZoomText")
With xShape
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then
'.Delete
.Visible = False
.TextFrame2.TextRange.Text = " "
Else
.Left = xRg.Left
.Top = xRg.Top
.TextFrame2.TextRange.Text = xRg.Range("A1").Text
.Visible = True
End If
End With
Fehler:
With Err
Select Case .Number
Case 0
Case -2147024809 'Textbox noch nicht vohanden
'Textfeld anlegen und formatieren
Set xShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
Left:=xRg.Left, Top:=xRg.Top, Width:=200, Height:=60)
With xShape
.Name = "ZoomText"
.TextFrame2.TextRange.Font.Size = 24
.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
.OLEFormat.Object.PrintObject = msoFalse
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing: Set xShape = Nothing
End Sub

Anzeige
AW: Zelleninhalt vergrößern
28.11.2019 17:43:00
Thomas
Hallo Franz,
klappt super danke.
welche Änderung muss man vornehmen, wenn man das vergrößerte Textfeld nicht oben links, sonder unten links an der Zelle anheften möchte?
Gruß Thomas
AW: Zelleninhalt vergrößern
29.11.2019 08:06:39
fcs
Hallo Thomas,
die Zeile
           .Top = xRg.Top

ändern in
           .Top = xRg.Offset(1, 0).Top

LG
Franz

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige