481 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo,
Ich versuche immer noch mit meinen kopierten Grafiken zu arbeiten.
da ich bei jedem arbeitsgang eine bis mehrere zeilen lösche sollen die grafiken parallel zum restlichen text aufrutschen. Es werden immer 2 zeilen gleichzeitig gelöscht die zusammen eine zeilenhöhe von 0,73cm haben. Mit folgendem Code versuche ich das ganze umzurechnen:

wksZiel.Shapes(wksZiel.Shapes.Count).IncrementTop -0.73


ich habe auch schon 7.3 und 73 versucht aber nichts passt.

ich habe auch schon versucht die Zeilenhöhe in Punkten umzurechnenmit 0,035277778cm / Punkt
aber 1.402291676 passt auch nicht.

hat jemand eine idee?

6 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

soweit ich weiß entspricht 1 cm = 28,35 Punkten. Du müsstest also 20,70 abziehen.

Aber du kannst auch gleich die entsprechende Zeile zuweisen. Hier der Code von deiner ersten Anfrage entsprechend abgeändert:

Sub ShapeKopieren()
Dim shaC As Shape
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet

Set wksQuelle = Worksheets(1)
Set wksZiel = Worksheets(6)

For Each shaC In wksQuelle.Shapes
If Not Intersect(shaC.TopLeftCell, Range("A1:H80")) Is Nothing Then
shaC.Copy
With wksZiel
.Paste
.Shapes(wksZiel.Shapes.Count).Top = .Cells(shaC.TopLeftCell.Row - 2, shaC.TopLeftCell.Column).Top 'Grafik 2 Zeilen höher einfügen
.Shapes(wksZiel.Shapes.Count).Left = shaC.Left
End With
End If
Next

End Sub


Gruß

M.O.
0 Punkte
Beantwortet von
Hallo,
vielen Dank für die schnelle Hilfe! Ich probiere es gleich mal aus!
LG
SirSolaris
0 Punkte
Beantwortet von
Hi,

Ich habe das ausprobiert und die "-2" durch eine Variable ersetzt abhängig davon wie viele zeilen gelöscht wurden. mit einer message box habe ich die variable überprüft und sie stimmt. trotzdem versetzt excel die beiden logos von Zeile 80 in zeile 1 statt in zeile 72.

auch mit den 20,6955 klappt es nicht wie gewünscht :(

weisst du weiter?

lg
SirSolaris
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

poste doch mal deinen geänderten Code (den wo du die Zeilen abziehst), dann kann mal schauen, wo der Fehler liegt.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O. Entsculdige den Verzug. nach wheinachten hatte ich 2 Heftige Klausurwochen. Ich hoffe du hilfst mir trotzdem :)

Es geht um 4 Zeilenpaare von denen eins beschriftet ist oder eben nicht. das andere dient zur räumlichen und farblichen abtrennung zur nächsten zeile. jedes zeilenpaar ist 29,75 (Rechtsklick -> Zeilenhöhe in cm?) hoch. daher sollen diese 29,75cm jedesmal an der höhe des logos abgezogen werden wenn der wert in der Zelle H33-H39 0 ist. Aber sie bewegen sich nicht...


For Each shaC In wksQuelle.Shapes 'Übertragung Briefkopf und 3 Logos funktioniert
If Not Intersect(shaC.TopLeftCell, Range("A1:H80")) Is Nothing Then
shaC.Copy
wksZiel.Paste
wksZiel.Shapes(wksZiel.Shapes.Count).Top = shaC.Top
wksZiel.Shapes(wksZiel.Shapes.Count).Left = shaC.Left

If Not Intersect(shaC.TopLeftCell, Range("A44:H80")) Is Nothing Then 'Anpassung an die Höhe
For L = 33 To 39 Step 2
If wksQuelle.Cells(L, 8).Value = 0 Then
wksZiel.Shapes(wksZiel.Shapes.Count).IncrementTop -20.6955
End If
Next L
End If
End If
next shaC


Kennt sich da jemand aus?
vielen Dank
LG SirSolaris
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

bei mir funkioniert die Verschiebung mit deinem geposteten Code, allerdings nur, wenn eine Grafik aus dem Quellblatt aus dem Bereich zwischen A44 und H80 in das neue Blatt eingefügt wird.
Wenn du die Zeilenhöhe mit Rechtsklick auf 29,75 festlegst, dann sind das keine Zentimenter (wäre ja fast die Größe einer DIN A4 Seite) sondern Punkte. Daher kannst im Code auch die 29,75 abziehen.

Gruß

M.O.
...