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
Rot Sub oder Function nicht definiert
23.02.2023 22:30:13 ralf_b
NotSolved
24.02.2023 07:46:38 Nicolle
NotSolved
24.02.2023 07:51:47 Gast76920
NotSolved
24.02.2023 19:50:36 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
ralf_b
Datum:
23.02.2023 22:30:13
Views:
361
Rating: Antwort:
  Ja
Thema:
Sub oder Function nicht definiert
du könntest dass auch so umsetzen. testen mußt du aber selber.
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

 


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
Rot Sub oder Function nicht definiert
23.02.2023 22:30:13 ralf_b
NotSolved
24.02.2023 07:46:38 Nicolle
NotSolved
24.02.2023 07:51:47 Gast76920
NotSolved
24.02.2023 19:50:36 ralf_b
NotSolved