• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA code niet compleet en met bug

Status
Niet open voor verdere reacties.
S

StijnDM

Gebruiker
Lid geworden
30 nov 2016
Berichten
9
Beste helpmij vrienden

Ik ben nieuw hier dus hoop op de juiste plek te zijn voor deze vraag te stellen.

Ik heb VBA code gevonden die bijna werkt maar met een paar bugs zit.

De code in kwestie is
---------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iTeller%


For iTeller = 1 To 2
On Error Resume Next
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete


On Error GoTo 0

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
_
IIf(iTeller = 2, 0, Target.Left), _
IIf(iTeller = 1, 0, Target.Top), _
IIf(iTeller = 1, Target.Cells.Width, _
_
Cells(Target.Row, 1).Width), _
_
_
IIf(iTeller = 1, _
_
_
Cells(1, Target.Column).Height, Target.Cells.Height))

.Name = IIf(iTeller = 1, "kolom", "rij")


With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 15
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
Next iTeller
End Sub
------------------------------------------------------------

Nu als ik op de linkerkolom druk (niet A1) maar de cijferkolom chrasht mijn code.
Plus als noob vind ik nergens waar ik de code zo kan aanpassen dat ik een rij/deel van rij kan laten oplichten in de plaats van de cellen die nu oplichten. Graag wat hulp!

Alvast bedankt

Stijn
 
Loopt perfect, wat is er eigenlijk mis?

Als je bv H5 selecteert licht H1 en A5 op.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iTeller%


For iTeller = 1 To 2
On Error Resume Next
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete


On Error GoTo 0

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, IIf(iTeller = 2, 0, Target.Left), IIf(iTeller = 1, 0, Target.Top), IIf(iTeller = 1, Target.Cells.Width, Cells(Target.Row, 1).Width), IIf(iTeller = 1, Cells(1, Target.Column).Height, Target.Cells.Height))

.Name = IIf(iTeller = 1, "kolom", "rij")


With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 15
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
Next iTeller
End Sub
 
Verplaats de "On Error GoTo 0" naar boven:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iTeller%

[COLOR="#FF0000"]On Error GoTo 0[/COLOR]

For iTeller = 1 To 2
On Error Resume Next
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
IIf(iTeller = 2, 0, Target.Left), _
IIf(iTeller = 1, 0, Target.Top), _
IIf(iTeller = 1, Target.Cells.Width, _
Cells(Target.Row, 1).Width), _
IIf(iTeller = 1, _
Cells(1, Target.Column).Height, Target.Cells.Height))

.Name = IIf(iTeller = 1, "kolom", "rij")

With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 15
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
Next iTeller
End Sub
 
Gijsbert1 zei:
Verplaats de "On Error GoTo 0" naar boven:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iTeller%

[COLOR="#FF0000"]On Error GoTo 0[/COLOR]

For iTeller = 1 To 2
On Error Resume Next
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
IIf(iTeller = 2, 0, Target.Left), _
IIf(iTeller = 1, 0, Target.Top), _
IIf(iTeller = 1, Target.Cells.Width, _
Cells(Target.Row, 1).Width), _
IIf(iTeller = 1, _
Cells(1, Target.Column).Height, Target.Cells.Height))

.Name = IIf(iTeller = 1, "kolom", "rij")

With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 15
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
Next iTeller
End Sub
Klik om te vergroten...

Super dit is al in orde!!!

Kan je me alleen nog zeggen waar in de code ik kan zeggen welke cellen oplichten?

Dan ben ik jullie eeuwig dankbaar :love:
 
Die verplaatsing van die On Error doet niet ter zake maar wel de onderbreking van die With..... regel.
Voor die selectie heb je eigenlijk niet meer nodig dan dit:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.EnableEvents = False
      Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column)).Select
   Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Ha Cobbe,

Ik ben niet heel sterk met VBA en kan het best mis hebben, maar:
Als je een kolom of rij selecteert (en dus niet een willekeurig(e) cel/bereik) krijg ik in de initiële code een foutmelding omdat hier de on error na onderstaande regel staat.
Code: 
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete
Door het verplaatsen was onderstaande opmerking van TS verholpen:
Nu als ik op de linkerkolom druk (niet A1) maar de cijferkolom chrasht mijn code.
Klik om te vergroten...


Plus als noob vind ik nergens waar ik de code zo kan aanpassen dat ik een rij/deel van rij kan laten oplichten in de plaats van de cellen die nu oplichten. Graag wat hulp!
Klik om te vergroten...
De vraag van TS is me niet geheel duidelijk, maar als het enkel gaat om de selectie te markeren lijkt mij onderstaande code afdoende:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo 0
On Error Resume Next
ActiveSheet.Shapes("shape").Delete
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
Target.Left, Target.Top, Target.Cells.Width, Target.Cells.Height)
.Name = "shape"
With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 11
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
End Sub
 
Laatst bewerkt:
Gijsbert1 zei:
Ha Cobbe,

Ik ben niet heel sterk met VBA en kan het best mis hebben, maar:
Als je een kolom of rij selecteert (en dus niet een willekeurig(e) cel/bereik) krijg ik in de initiële code een foutmelding omdat hier de on error na onderstaande regel staat.
Code: 
ActiveSheet.Shapes(IIf(iTeller = 1, "kolom", "rij")).Delete
Door het verplaatsen was onderstaande opmerking van TS verholpen:




De vraag van TS is me niet geheel duidelijk, maar als het enkel gaat om de selectie te markeren lijkt mij onderstaande code afdoende:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo 0
On Error Resume Next
ActiveSheet.Shapes("shape").Delete
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
Target.Left, Target.Top, Target.Cells.Width, Target.Cells.Height)
.Name = "shape"
With .Fill
.Visible = msoTrue
.ForeColor.SchemeColor = 11
.Transparency = 0.7
End With
.Line.Visible = msoFalse
End With
End Sub
Klik om te vergroten...

Dit is bijna wat ik zocht.. waar kan ik dan zeggen dat een hele rij moet oplichten in deze code?

Alvast heeeeel veel dank!!

Groetjes Stijn
 
Je hebt toch niet meer nodig dan dit:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Rows(Target.Row).Select
End Sub
 
Stijn,

Zou je AUB niet op Quote willen drukken maar gewoon op reageer op bericht als je reageert?

Even voor de goede orde, er wordt niets opgelicht, maar er word een shape geplaatst waarvan de afmetingen worden bepaalt a.d.h.v je selectie.
Dit gebeurd hier:
Code: 
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
[COLOR="#FF0000"]Target.Left[/COLOR], [COLOR="#4B0082"]Target.Top[/COLOR], [COLOR="#40E0D0"]Target.Cells.Width[/COLOR], [COLOR="#00FF00"]Target.Cells.Height[/COLOR])

Rood = kolom start positie (linksboven)
Paars = rij start positie (linksboven)
Blauw = breedte
Groen = hoogte
 
Excuses Gijsbert

Hoe kan ik er dan voor zorgen dat het een object plaatst op een stuk van de rij? bv A1 tot A10

Groetjes
 
Code: 
With Range("A1")
    ActiveSheet.Shapes.AddShape msoShapeRectangle, .Left, Top, .Width, Range("A11").Top
End With

Met vriendelijke groet,


Roncancio
 
Roncancio

Hoe ziet de code er dan volledig uit want nu kan ik er helaas niet meer goed aan uit.

Al bedankt voor de hulp aan iedereen trouwens!!

groetjes
 
Stijn,

Wat wil je nu precies? Is mij niet echt duidelijk!
Hoe kan ik er dan voor zorgen dat het een object plaatst op een stuk van de rij? bv A1 tot A10
Klik om te vergroten...
Wanneer wil je dat dit gebeurd? Bij welke selectie moet het A1 t/m A10 zijn?
 
Gijsbert

Ik wou de code zo aanpassen dat als ik op een rij ga staan dat er een 'shape' over een aantal cellen komt. Dus het zou op de actieve rij moeten zijn. :o

Sorry voor de onduidelijkheid hoor, zal in het vervolg mijn probleem beter proberen formuleren. :confused:

Groetjes

Stijn
 
Wat bepaalt hoe groot en/of breed een shape moet zijn?

Met vriendelijke groet,


Roncancio
 
Dan wordt mijn vraag toch, hoe groot moet dat deel zijn? Zit daar enig logica in?
Wil je per se een shape gebruiken of gaat het om het oplichten van de rij?

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Roncancio

Ideaal zou zijn dat dit per document aan te passen zou zijn.

In sommige van mijn documenten gaat dit over 10 cellen naast elkaar, en in andere over 15 cellen.

Dus als ik de Range kan bepalen in deze code zou mijn probleem opgelost zijn. Het is belangrijk dat dit een shape is want anders past het de kleuren van mijn rij aan, wat niet mag.

Alvast bedankt

Groetjes

Stijn
 
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveCell
    ActiveSheet.Shapes.AddShape msoShapeRectangle, .Left, .Top, .Width, .Offset(10, 1).Top - .Top
End With
End Sub
Bovenstaande code toont een shape beginnend bij huidige cel tot aan 10 cellen daaronder.
Overigens heb je het over rijen ipv kolommen.

In dat geval:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveCell
      ActiveSheet.Shapes.AddShape msoShapeRectangle, .Left, .Top, .Offset(1, 10).Left - .Left, .Height
End With
End Sub

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan