Thema Datum  Von Nutzer Rating
Antwort
23.02.2023 14:16:22 Nicolle
NotSolved
23.02.2023 14:30:29 Gast96207
NotSolved
23.02.2023 15:33:57 Gast50947
NotSolved
23.02.2023 15:47:59 Gast87154
NotSolved
23.02.2023 16:23:54 Der Steuerfuzzi
NotSolved
23.02.2023 16:56:15 Gast97593
NotSolved
23.02.2023 16:56:19 Gast7086
NotSolved
23.02.2023 17:10:00 Der Steuerfuzzi
NotSolved
24.02.2023 07:44:19 Nicolle
NotSolved
23.02.2023 21:39:31 Mase
NotSolved
23.02.2023 22:30:13 ralf_b
NotSolved
24.02.2023 07:46:38 Nicolle
NotSolved
Rot Sub oder Function nicht definiert
24.02.2023 07:51:47 Gast76920
NotSolved
24.02.2023 19:50:36 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Gast76920
Datum:
24.02.2023 07:51:47
Views:
349
Rating: Antwort:
  Ja
Thema:
Sub oder Function nicht definiert

Sub KTFAbisC()

    '

    '                                                                 A1         A1    (Abgerufener Wert in Zelle I1)

    checkvalues Range("I1"), "Oval 3"

    checkvalues Range("I2"), "Oval 4"

    checkvalues Range("I3"), "Oval 7"

    checkvalues Range("I4"), "Oval 6"

    checkvalues Range("I5"), "Oval 17"

    checkvalues Range("I6"), "Oval 18"

 

End Sub

 

Sub checkvalues(rng As Range, shp As String)

   

  Dim shpe As Shape

  Set shpe = ActiveSheet.Shapes(shp)

   

    Select Case rng.Value

      Case 1: changeshape shpe, 0.8, 14.1732283465, 1.2

      Case 0: changeshape shpe, 1, 24.1732283465, 1.5

      Case 2: changeshape shpe, 0.65, 24.1732283465, 1.5

      Case 3: changeshape shpe, 0.5, 30.1732283465, 1.5

      Case Is >= 4: changeshape shpe, 0.4, 33.1732283465, 1.5

    End Select

    

 

End Sub

 

Sub changeshape(sh As Shape, transp As Double, heigt As Double, weigt As Double)

    

   With sh.ShapeRange

         With .Fill

            .Visible = msoFalse

            .ForeColor.RGB = RGB(255, 0, 0)

            .Transparency = transp

            .Solid

        End With

        With .Line

            .Visible = msoTrue

            .Weight = weigt

            .ForeColor.RGB = RGB(255, 0, 0)

        End With

       .LockAspectRatio = msoTrue

        .Height = heigt

        Range("H7").Select

    End With

 

End Sub

Da tritt bei mir ein Laufzeitfehler im letzten Abschnitt auf, bei    With sh.ShapeRange.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
23.02.2023 14:16:22 Nicolle
NotSolved
23.02.2023 14:30:29 Gast96207
NotSolved
23.02.2023 15:33:57 Gast50947
NotSolved
23.02.2023 15:47:59 Gast87154
NotSolved
23.02.2023 16:23:54 Der Steuerfuzzi
NotSolved
23.02.2023 16:56:15 Gast97593
NotSolved
23.02.2023 16:56:19 Gast7086
NotSolved
23.02.2023 17:10:00 Der Steuerfuzzi
NotSolved
24.02.2023 07:44:19 Nicolle
NotSolved
23.02.2023 21:39:31 Mase
NotSolved
23.02.2023 22:30:13 ralf_b
NotSolved
24.02.2023 07:46:38 Nicolle
NotSolved
Rot Sub oder Function nicht definiert
24.02.2023 07:51:47 Gast76920
NotSolved
24.02.2023 19:50:36 ralf_b
NotSolved