Supportnet Computer Supportnet Games Supportnet Kochen Explipedia
Login: guestBesucher online: 170
Supportnet Computerforum
SUPPORT
Home
Forum
Tipps & Infos
Blitz Angebote
Members
Hilfe
Video

TOP THEMEN
SSD Test
Alles über SSDs

Android Tipps
iPad Tipps
Google Tipps
Windows 8 FAQ
Windows 7 FAQ
E-Mail FAQ
Netzwerk FAQ
Festplatten FAQ
Datenrettung FAQ
Bildbearbeitung FAQ

Top iPhone Apps
Computer Einsteiger
Die 5 besten...
Explipedia
Themen
Direktlinks

Neue Einträge
News einsenden News einschicken
Tipps einsenden Tipp einschicken

SN-LINKS

Suche
Befreundete Seiten
Top Seiten

Supportnet/Forum/Tabellenkalkulation



Supportnet/Forum/Tabellenkalkulation
von SirSolaris vom 22.12.2016, 18:36 Diese Seite den Supportnet Favoriten hinzufügen  Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden


Grafikhöhe per VBA verändern Maßheinheiten

 (209 Hits)

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?


Antwort schreiben 50 Bonuspunkte

Antworten...
Antwort 1 von M.O. vom 23.12.2016, 08:27 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

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.


Antwort noch nicht bewertet Als gute Antwort bewerten
Diese Antwort hat mein Problem gelöst
Antwort 2 von SirSolaris vom 23.12.2016, 11:25 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo,
vielen Dank für die schnelle Hilfe! Ich probiere es gleich mal aus!
LG
SirSolaris


Antwort noch nicht bewertet
Antwort 3 von SirSolaris vom 23.12.2016, 11:47 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

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


Antwort noch nicht bewertet
Antwort 4 von M.O. vom 23.12.2016, 12:06 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

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.


Antwort noch nicht bewertet Als gute Antwort bewerten
Diese Antwort hat mein Problem gelöst
Antwort 5 von SirSolaris vom 17.01.2017, 16:42 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

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


Antwort noch nicht bewertet
Antwort 6 von M.O. vom 18.01.2017, 09:03 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

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.


Antwort noch nicht bewertet Als gute Antwort bewerten
Diese Antwort hat mein Problem gelöst




Antwort schreiben
    Bitte einen 'Nickname' wählen.
Nickname:*
    (eMail-Adresse wird nicht veröffentlicht.)
eMail:
Nachricht: Ich möchte bei Antworten benachrichtigt werden.
    Hilfe zur Beitragsformatierung gibts [hier]
                   
Antwort:*
  Die Nutzungsbedingungen habe ich gelesen und akzeptiert.

MACHEN SIE IHRE WEBSITE ATTRAKTIVER
Sie haben eine eigene Website und wollen Ihre Besucher auf den Supportnet-Service aufmerksam machen? Kopieren Sie einfach den Quellcode in Ihre Seite und jeder Besucher Ihrer Seite kann direkt auf die Supportnet-Datenbank zugreifen.

My Supportnet


SUCHE

Gruppen im Forum
Betriebsysteme
Software
Hardware
Netzwerk
Programmierung
Sonstiges

Impressum © 1997-2015 SupportNet
Version: supportware 1.8.230E / 18.10.2010, Startzeit:Mon Mar 20 23:29:06 2017