Automatisch sorteren cellen

[Richard.H]

bedankt, dat werkt wel maar als ik in de gevensvalidatielijst op cel c17 daarna een andere keuze maak verandert hij direct weer in de waarde die net gekopieerd is.

 

[HSV]

En bij welk veranderende cel wil je dat C17 de waarde krijgt van A71.

Bv. alleen bij verandering van cel A1.

If target.address = "$A$1" then  Sheets("Serie").Range("C17") =  Sheets("Opties").Range("A71").value

 

[Richard.H]

Dezelfde als die bij het plaatje ik dacht c4?

 

[HSV]

"$A$1" wordt ?

 

[Richard.H]

Sheets("Filter").Range("C4") moet de trigger zijn

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Sheets("Filter").Range("C4")

  
        pic = Sheets("Filter").Range("C4")
    
 
      
      
      

Set Afbeelding = ActiveSheet.Pictures.Insert(pic)
    With Afbeelding
        .Top = Rows(5).Top
        .Left = Columns(2).Left
        .Height = Application.CentimetersToPoints(10)
        .Width = Application.CentimetersToPoints(5)
      
    End With
  
       Set KeyCells = Sheets("Filter").Range("C4")
      Application.EnableEvents = False
 Sheets("Serie").Range("C17") = Sheets("Opties").Range("A71").Value
Application.EnableEvents = True

End Sub

 

[Richard.H]

of is de plaats waar de code moet staan soms verkeerd? ik heb deze ook onder pic = geplaatst

 

[HSV]

Zet dit bij in de bladmodule van blad Filter.

Private Sub Worksheet_Calculate()
 Sheets("Serie").Range("C17") = Sheets("Opties").Range("A71").Value
End Sub

Als er iets wijzigt in tabblad Filter (het resultaat van de formule in C4) gaat de code lopen.

 

[Richard.H]

Nu verandert hij niet, maar ook niet als cel C4 veranderd....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Sheets("Filter").Range("C4")

   
        pic = Sheets("Filter").Range("C4")
     
 
       
       
       

Set Afbeelding = ActiveSheet.Pictures.Insert(pic)
    With Afbeelding
        .Top = Rows(5).Top
        .Left = Columns(2).Left
        .Height = Application.CentimetersToPoints(10)
        .Width = Application.CentimetersToPoints(5)
       
    End With
   

      Application.EnableEvents = False
           
 If Target.Address = "$C$4" Then Sheets("Serie").Range("C17") = Sheets("Opties").Range("A71").Value
Application.EnableEvents = True

End Sub

 

[Richard.H]

Zet dit bij in de bladmodule van blad Filter.

Private Sub Worksheet_Calculate()
 Sheets("Serie").Range("C17") = Sheets("Opties").Range("A71").Value
End Sub

Als er iets wijzigt in tabblad Filter (het resultaat van de formule in C4) gaat de code lopen.

Yes... Dit werkt. weer super bedankt!

 

[Richard.H]

Zoals altijd als je iets gaat veranderen of toevoegen komen er nieuwe problemen...
zo ook deze:

Als je een nieuwe serie gaat toevoegen op het tabblad Nieuwe serie, en dan kopieert met de knop Nieuwe serie kopieren, naar serie info, plakt hij een aantal plaatjes op dit tabblad wat niet de bedoeling is...

 

[Richard.H]

Ik heb de volgende code toegevoegd om het plaatje (wat hij eigenlijk niet moet gaan plakken) op de juiste blad neerzet.

Sheets("Serie").Activate

Hij mag bij het uitvoeren van de private sub op blad nieuwe serie, de private sub worksheet_change niet uitvoeren.

Ook blijft het plaatje van de vorige keer staan en hij zet er een nieuwe overheen, er stonden er een paar honderd bovenop elkaar....

 

[HSV]

Maak gebruik van 'EnableEvents' en delete de plaatjes voordat je een nieuwe plaatst.

 

[Richard.H]

sorry maar ben een newbee als het om vba gaat...
Probeer al van alles maar nog geen code die werkt.
De bedoeling is voordat er een nieuw plaatje geplaatst wordt, de oude wordt weggehaald.

 

[HSV]

Met welke code in welke module voeg je een plaatje toe?

 

[Richard.H]

Private Sub Worksheet_Change(ByVal Target As Range)


' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Sheets("Filter").Range("C4")


pic = Sheets("Filter").Range("C4")

Sheets("Serie").Activate

Set Afbeelding = ActiveSheet.Pictures.Insert(pic)
With Afbeelding
.Top = Rows(5).Top
.Left = Columns(2).Left
.Height = Application.CentimetersToPoints(10)
.Width = Application.CentimetersToPoints(5)

End With


Application.EnableEvents = False


If Target.Address = "$C$4" Then Sheets("Serie").Range("C17") = Sheets("Opties").Range("A71").Value


Application.EnableEvents = True




End Sub


op blad "Serie"

 

[HSV]

Test het maar eens (plaatje wordt verwijderd).

 

[Richard.H]

helaas werkt het bij mij niet... ik zie nu helemaal geen plaatje meer....

 

[HSV]

Ik wist niet dat je zo snel was, ik heb het bestand verwijdert en opnieuw geplaatst.
Misschien even opnieuw proberen.

 

[Richard.H]

hahah, ik was idd rapido...
Het lijkt nu wel te werken, alleen als er geen plaatje staat gaat hij in de fout.
Shapes("plaatje").Delete, geeft fout naam is niet gevonden.
wat logisch is er is geen plaatje meer.

misschien een check toevoegen of de naam bestaat of niet?

 

[HSV]

Dit plaatsen op de plek van bestemming.

' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
If Target.Address(0, 0) = "F5" Then
 Application.EnableEvents = False
       pic = Sheets("Filter").Range("C4").Value
 For Each sh In Shapes
  tekst = tekst & "|" & sh.Name & "|"
 Next sh
    If InStr(tekst, "|plaatje|") Then Shapes("plaatje").Delete
Set Afbeelding = Pictures.Insert(pic)