Excel vormen

[LauravT]

Hallo,

Ik ben op zoek naar een manier om de waarde in de vormen automatisch aan te laten passen.
Onderstaande code heb ik.

ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Sheets("Blad2").Range("B2")

Deze werkt gewoon, echter zoek ik een manier om op deze manier alle vormen na te gaan en automatisch aan te laten passen.
Het idee is dat vorm 1 waarde 1 zoekt op tab Blad2 in kolom A en daar dan de waarde uit kolom B pakt, welke gelijk is aan B2 voor vorm 1, B3 voor vorm 2, etc.

Helaas lukt het mij niet om dit voor elkaar te krijgen, kan iemand mij hierin helpen?

Groetjes,..

 

[Haije]

Laura,

plaats eens een Excelbestand waar dit in moet gebeuren....

Verwijder eerst wel evt. aanwezige "gevoelige" informatie

 

[LauravT]

Zie bijgevoegd bestand.

De bedoeling is dus dat vorm 1 de naam mee krijgt van nr 1 in de data en indien mogelijk de kleur die onder kleurcode staat (FYI ik heb zomaar wat nrs ingevuld bij kleurcode, deze zijn dus fictief).

Bekijk bijlage 294595

 

[HSV]

Ervan uitgaande dat de nummers van de shape gewoon in kolom A staan.

Sub hsv()
Dim sh As Shape
For Each sh In Sheets("blad2").Shapes
 If sh.Type <> msoFormControl Then
    With Sheets("data").Columns(1).Find(sh.TextEffect.Text, , , xlWhole)
       sh.Name = .Offset(, 1)
       sh.Fill.ForeColor.SchemeColor = .Offset(, 2)
    End With
 End If
Next sh
End Sub

 

[LauravT]

Helaas, krijg een Fout 91 tijdens uitvoering melding.

Hij geeft aan dat Objectvariabele of blokvariabele With is niet ingesteld.
Bij foutopsporing geeft ie onderstaande regel aan:

       sh.Name = .Offset(0, 1)

 

[HSV]

Niet in het voorbeeldbestand.

 

[LauravT]

Hmm,.. bij mij doet ie het ook in het voorbeeldbestand niet.
Maar zie dat ie in de code zoekt naar de tekst in de vorm, is het ook mogelijk om het te laten zoeken naar de naam van de vorm (rechthoek 1, rechthoek 2, etc)?

 

[HSV]

Ik zou het niet op naam van de shape doen, immers de naam ga je veranderen en dan kan je de code maar een keer gebruiken.

Sub hsv()
Dim sh As Shape
For Each sh In Sheets("blad2").Shapes
 If sh.Type <> msoFormControl Then
    With Sheets("data").Cells(sh.ID, 1)
       sh.Name = .Offset(, 1)
       sh.Fill.ForeColor.SchemeColor = .Offset(, 2)
    End With
 End If
Next sh
End Sub

 

[LauravT]

Het idee is dat de vormen elke keer weer een ander kleurtje moeten kunnen krijgen.
Ik heb nu onderstaande code, met dank aan HSV.

Sub hsv()

Dim sh As Shape

For Each sh In Sheets("Vormen 2").Shapes
 If sh.Type <> msoFormControl Then
    With Sheets("Data").Columns(1).Find(sh.Name, , , xlWhole)
       sh.Fill.ForeColor.SchemeColor = .Offset(, 1)
       sh.TextFrame2.TextRange.Characters.Text = .Offset(0, 1)
    End With
 End If
Next sh

End Sub

Zo blijft de naam van de vorm altijd hetzelfde, veranderd de waarde wel (precies zoals ik wil).
Allen blijf ik de object-/blokvariabele fout krijgen mbt with.
Ik heb het al nagelopen of er mogelijk ongeldige kleurcodes inzitten, maar dit is niet het geval.
Heb kleurcodes lopen van 1 tm 75.

Iemand enig idee waarom hij deze fout geeft?

MVG

 

[snb]

De bijlage in #3 doet het niet meer. Kun je het bestand opnieuw uploaden ?

 

[HSV]

Die link naar de bijlage hield er na ± een half mee op.

Hier het bestandje die er stond.

 

[LauravT]

Dank voor het plaatsen HSV!

 

[snb]

Sub M_snb()
    sn = Blad1.Cells(1).CurrentRegion
    
    For Each it In Blad2.Shapes
       it.Fill.ForeColor.SchemeColor = sn(it.ID, 3)
       it.TextEffect.Text = sn(it.ID, 2)
    Next
End Sub

 

[LauravT]

Bedankt voor alle reacties!
Ik heb het echter nu opgelost, ik weet niet waarom maar heb de vormen opnieuw in Excel moeten zetten, om een of andere reden herkende hij deze niet?
De code die ik nu gebruik is die van HSV.