Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 09:04:14
Erfahrung Umstieg in Sharpoint
24.04.2024 08:01:34
Textbox Inhalt prüfen und Code abbrechen
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1312to1316
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1312to1316
1312to1316
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Shape über Zellen verändern

Shape über Zellen verändern
14.05.2013 21:41:09
Andy
Hallo,
habe diesen Code in meiner Arbeitsmappe.
wie kann mann den Shape die breite und höhe in einer Zelle als Zentimeter eingeben,
und diese soll sich dann anpassen.
Danke in voraus!!
Sub Shape() Dim xlShp As Shape Application.ScreenUpdating = False With Worksheets(1).Range("C2") Set xlShp = .Parent.Shapes.AddShape(msoShapeRectangle, _ .Left, .Top, .Width * 6, .Height * 12) End With xlShp.Fill.ForeColor.RGB = RGB(255, 255, 0) Application.ScreenUpdating = True Set xlShp = Nothing End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Was soll sich Wem anpassen? (owT)
14.05.2013 21:47:59
EtoPHG

AW: Was soll sich Wem anpassen? (owT)
14.05.2013 22:29:13
Andy
die jeweiligen Shapes die ich anklicke.
Hier möchte ich in einer Zelle z.B. A1 Höhe A2 Breite in cm eingeben, und das jeweilige Shape ändert sich in höhe und breite.

Dann so
15.05.2013 09:21:48
EtoPHG
Hallo Andy,
Für Höhe in A1:Cells(1,1) und Breite in A2:Cells(2,1)
Diesen Code in ein Modul: 
Sub shapeSize()
If Val(Cells(1, 1))
Dann alle Shapes selektieren und Rechtsklick - Makro zuweisen ShapeSize.
Bei Klick auf das Shape werden dessen Grössen entsprechend den Werten in A1xA2 angepasst.
Gruess Hansueli

Anzeige
mit einer UDF
15.05.2013 08:29:14
ransi
HAllo Andy
Versuch mal sowas.
Diesen Code in ein Modul:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Public Function machs(hoehe, Breite)
    Dim xlShp As Object
    On Error Resume Next
    With Application.ThisCell
        If .Parent.Shapes("myShape" & .Address(0, 0)) Is Nothing Then
            .Parent.Shapes.AddShape(msoShapeRectangle, .Left, .Top, Breite * 28.3464566929, hoehe * 28.3464566929).Name = "myShape" & .Address(0, 0)
            Else:
            With .Parent.Shapes("myShape" & .Address(0, 0))
                .Width = Breite * 28.3464566929
                .Height = hoehe * 28.3464566929
            End With
        End If
        machs = Not .Parent.Shapes("myShape" & .Address(0, 0)) Is Nothing
    End With
End Function


Jetzt trägst in die Zelle die das Shape hat einfach die Formel ein.
Tabelle1

 ABC
132WAHR
2   

Formeln der Tabelle
ZelleFormel
C1=machs(A1;B1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
ransi

Anzeige
Application.CentimetersToPoints...
15.05.2013 09:34:28
ransi
HAllo
....ist gut ;-)
Alternativ zu HAns seinem Vorschlag:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function machs(hoehe, Breite)
    On Error Resume Next
    With Application.ThisCell
        If .Parent.Shapes("myShape" & .Address(0, 0)) Is Nothing Then
            .Parent.Shapes.AddShape(msoShapeRectangle, _
                .Left, .Top, Application.CentimetersToPoints(Breite), Application.CentimetersToPoints(hoehe)).Name = "myShape" & .Address(0, 0)
            Else:
            With .Parent.Shapes("myShape" & .Address(0, 0))
                .Width = Application.CentimetersToPoints(Breite)
                .Height = Application.CentimetersToPoints(hoehe)
            End With
        End If
        machs = Not .Parent.Shapes("myShape" & .Address(0, 0)) Is Nothing
    End With
End Function


ransi

Anzeige
AW: Application.CentimetersToPoints...
15.05.2013 19:56:03
Andy
Hallo,
Vielen Dank, ist genau das richtige was ich brauche!!
Wie bekommt man das hin mit der Programmierung, ich steh immer auf den Schlauch wenn ich was Umsätzen will.
Was für Lektüren gibt es?

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige