Zeilenbreite anpassen
04.08.2005 07:57:47
Brit
Ich habe den Auftrag, eine kleine Routine zum Einlesen von Signaturen zu schreiben! Das sind Liniensignaturen, die zur besseren Anschaulichkeit ein wenig in der Größe angepasst werden müssen! So weit so gut! Klappt auch alles!
Nun soll dieses Signatur, die länger als die jeweilige active Zelle ist, in der Länge angepasst werden! In der Höhe klappt das ja auch super! Nur die Länge macht mir Kopfzerbrechen!!!
Nun habe ich überprüft , ob die richtige Zelle aktiev ist, wie breit sie ist, wie breit das Bild ist ....
Ich habe versucht, ihm zu sagen, wenn die Bildbreite größer ist als die Zellebreite, dann mach die Zellenbreite so groß wie die Bildbreite!
Aber irgentwie arbeitet er wohl mit verschiedenen Maßstäben.
Mit der Messagebox "Hallo" wollte ich abfragen, ob er überhaupt die Bedingung erfüllt! Das tut er! Lange Rede kurzer Sinn! Wo könnte mein Fehler liegen?
Brit
Sub LinienEinfuegenN13()
Dim code, zelle
Range("A:A").Activate
On Error Resume Next
i = 0
For Each zelle In Range("A:A")
i = i + 1
code = LCase(zelle.Value & ".eps")
zelle.Offset(0, 4).Activate
ActiveSheet.Pictures.Insert (ThisWorkbook.Path & "\eps\" & code)
' Auswählen und Vergrößern der jeweiligen Linie zur besseren Erkennbarkeit
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.ScaleWidth 2.8, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2.8, msoFalse, msoScaleFromTopLeft
ShapeHeight = ActiveSheet.Pictures(i).Height
Shapewidth = ActiveSheet.Pictures(i).Width
MsgBox "ShapeHeight " & ShapeHeight
MsgBox "ShapeWidth " & Shapewidth
' Anpassen der jeweiligen Zelle an die aktuelle Shape-Größe (Linie)
MsgBox "CellH " & ActiveCell.Height
MsgBox "CellW " & ActiveCell.Width
MsgBox ActiveCell.Address
If ShapeHeight > 15 Then ActiveCell.Rows.RowHeight = ShapeHeight
If Shapewidth > ActiveCell.Width Then
MsgBox "Hallo"
MsgBox "CellW1 " & ActiveCell.Width
ActiveCell.Width = Shapewidth
MsgBox "CellW2 " & ActiveCell.Width
End If
If ActiveCell.Offset(1, -4) = "" Then Exit For
ActiveCell.Offset(1, -4).Activate
Next zelle
End Sub