Shapes plaatsen zonder Select in de code

Status
Niet open voor verdere reacties.

franzeman

Gebruiker
Lid geworden
2 sep 2006
Berichten
98
Hallo VBA 'ers,

Ik werk met Excel 2007 en daarvan is het bekend, dat werken met Shapes de code zeer vertraagd. Je kunt dit (deels) ondervangen door termen als Select e.d. zo veel mogelijk te mijden.
Met mijn volgende code (met een groene en oranje pijl) gaat het zo inderdaad snel, maar de Increment-methode gaat uit van cel A1, terwijl ik mijn pijlen wil relateren aan een ActiveCell, bijv. Range("K20").
------------------------------------------------------------------------------------
Code:
Option Explicit
Sub voeg_pijlen_toe()

Dim sh1, sh2
Set sh1 = ActiveSheet.Shapes.AddShape(33, 5, 5, 20, 10) 'msoShapeRightArrow = 33
Set sh2 = ActiveSheet.Shapes.AddShape(33, 5, 5, 20, 10)

    With sh1 'groene pijl
        .Fill.ForeColor.RGB = RGB(146, 208, 80)
        .Line.ForeColor.RGB = RGB(146, 208, 80)
        .IncrementLeft 100
        .IncrementTop 150
    End With
    
    With sh2 'oranje pijl
        .Fill.ForeColor.RGB = RGB(255, 192, 0)
        .Line.ForeColor.RGB = RGB(255, 192, 0)
        .IncrementLeft 200
        .IncrementTop 150
        .IncrementRotation 180
    End With
    
End Sub
----------------------------------------------------------------------------------
Vraag: Hoe doe ik dat zonder, of zo min mogelijk, het gebruik van Select of Activate?

Met vriendelijke groet van,
Franzeman
 
Laatst bewerkt door een moderator:
Code:
For j=1 to 2
  With Sheets(1).Shapes.AddShape
    .Fill.ForeColor.RGB = iif(j=1,RGB(146, 208, 80),RGB(255, 192, 0))
    .Line.ForeColor.RGB = .fill.forecolor.RGB
    .IncrementLeft j*100
    .IncrementTop 150
    .incrementrotation=180*(j-1)
    .left=sheets(1).[K20].left
    .top=sheets(1).[K20].top 
    .width=sheets(1).[K20].width
    .height=sheets(1).[K20].height
  End With
Next
 
Laatst bewerkt:
Code:
For j=1 to 2
  With sh1 Sheets(1).Shapes.AddShape
    .Fill.ForeColor.RGB = iif(j=1,RGB(146, 208, 80),RGB(255, 192, 0))
    .Line.ForeColor.RGB = .fill.forecolor.RGB
    .IncrementLeft j*100
    .IncrementTop 150
    .incrementrotation=180*(j-1)
    .left=sheets(1).[K20].left
    .top=sheets(1).[K20].top 
    .width=sheets(1).[K20].width
    .height=sheets(1).[K20].height
  End With
Next

Dankjewel snb,

Hier kan ik wel wat mee. De code is snel en simpel (waarom kom ik daar nou niet op?).
De code sputterde bij mij aanvankelijk nog wat tegen bij de Incrementrotation. Bij j=1 is het vermenigvuldigen met 0. Maar met 'On error resume next' ging het prima.

Nogmaals bedankt!
Ik zal de vraag afmelden en ga weer verder met eieren zoeken...

Groetjes van Franzeman
 
Laatst bewerkt:
Kleine verbetering:

in regel With moet sh1 verwijderd worden (zie mijn aangepaste 1e bericht)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan