vorm opmaken van rechthoeken

Status
Niet open voor verdere reacties.
B

bo69

Gebruiker
Lid geworden
15 jul 2012
Berichten
28
Kan iemand mij helpen met een code.

Wil 60 rechthoeken met vba code: Blauw 60% transparant maken en tekst bol zwart.

En andere macro alle 60 rechthoeken met tekst 100 procent transparant maken

De rechthoeken zijn van 2 tot 60 genummerd
 
Doener op zijn minst een voorbeeldje bij, want het maakt nogal uit in welk programma je dat wilt doen.
 
sorry hier voorbeeld bestand

sorry hier voorbeeld bestand
 

Bijlagen

  • VormTest.xlsm
    127 KB · Weergaven: 14
voorbeeld bestand2

Dit bestand is wat duidelijker
 

Bijlagen

  • VormTest.xlsm
    127 KB · Weergaven: 20
Zoiets?

Code: 
Sub VenA()
  For Each shp In Sheets("Roaster (2)").Shapes
    If shp.AutoShapeType = msoShapeRectangle Then shp.Fill.Transparency = 1
  Next shp
End Sub
 
Hij werkt perfect, maar het bewerkt alle vormen en de teksten zijn niet transparant.
Alleen de Rechthoek2 t/m Rechthoek60.

Of kan tekst niet tranparant gemaakt worden. Anders tekst verkleinen, waardoor je het bijna niet ziet.

Ik had het in de macro module staan, zet het nu hieronder, waar ik aan dacht.
Deze heb ik met macro recorder aangemaakt. Alleen kon ik het met een cel opnemen.

Nu staat er bij je code Each, kan je daar ook aangeven 2 t/m 60
----------------------------------------------------------------
Code: 
Sub KnopOnzichtbaar()
'
'ActiveSheet.Shapes(2t/m60).Select
     
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Vet"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'
    Range("E38").Select
End Sub
-----------------------------------------------------------------------------
Sub KnopZichtbaar()
'

    'ActiveSheet.Shapes(2t/m60).Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Vet"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.399945066682943
        .PatternTintAndShade = 0
    End With

'
    Range("E38").Select
End Sub
 
Laatst bewerkt:
Zet de code eerst tussen codetags. Nu is het onleesbaar. In #5 staat toch een methode hoe je de shapes kan bewerken? Hier kan je natuurlijk extra opties/beperkingen aan toevoegen.
 
Laatst bewerkt:
bo69 zei:
Alleen de Rechthoek2 t/m Rechthoek60.

Nu staat er bij je code Each, kan je daar ook aangeven 2 t/m 60
Klik om te vergroten...
Nee, dat kan niet zo, maar wel zó:
Code: 
Sub KnopOnzichtbaar()
For I = 2 To 60
    If ActiveSheet.Shapes.Name = "Rechthoek" &  i Then
        ‘ etc.
    End If
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan