• 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.

Macro starten wanneer in een bereik ergens een celopmaak verandert

Status
Niet open voor verdere reacties.
Ik begin het een beetje te snappen (denk ik :))
Met ASAP-utility ASAPSUMBYFONTCOLOR(H3:H10;3) doe je de rekenkundige bewerking (hier rode font kleur) en jouw code start de herberekening bij iedere willekeurige kleurwisseling in gedefinieerde bereik(en) en maakt geen gebruik van de herberekingsroutine van ASAP.
Klopt mijn inzicht ?

Code: 
Sub Herberekenen_ASAP()
     Application.ScreenUpdating = False 'indien gewenst
     Application.EnableEvents = False 'indien gewenst
     Application.CalculateFull
     Application.EnableEvents = True 'indien gewenst
     Application.ScreenUpdating = True 'indien gewenst
End Sub
 
Yep,

Je kunt dus ook de ASAPSUMBYFONTCOLOR schrappen en jouw eigen functie die dit doet schrijven (dan werkt het ook op pc's waar ASAP niet op staat)
 
:thumb:
jouw eigen functie die dit doet schrijven ? Kun je me daarbij helpen. Volgens mij moet dat een UDF zijn/worden
 
@ Eric,
Ik heb de modules ingepast in mijn doel-workbook en een aantal testen gedaan met o.a. de andere macro in het workbook, andere workbooks bijgeladen en gerund. Alles werkt perfect en zonder conflicten/problemen. Heel fijn. Ik heb weer heel wat bijgeleerd (niet dat ik deze complexe codes helemaal doorgrond hoor !)
Met enorme dank voor je inspanningen.:thumb: :thumb: :thumb:

Voor degene die hierin geïnteresseerd zijn heb ik een bijgewerkt model toegevoegd. Wel moet hiervoor ASAP-utilities geïnstalleerd zijn.
 

Bijlagen

Laatst bewerkt:
anton44 zei:
:thumb:
jouw eigen functie die dit doet schrijven ? Kun je me daarbij helpen. Volgens mij moet dat een UDF zijn/worden
Klik om te vergroten...

Eureka. mbv Google gevonden op https://www.extendoffice.com/documents/excel/1418-excel-count-sum-by-font-color.html#a1.

Code: 
Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
Application.Volatile
Dim rng As Range
Dim xTotal As Double
xTotal = 0
For Each rng In pRange1
    If rng.Font.Color = pRange2.Font.Color Then
        xTotal = xTotal + rng.Value
    End If
Next
SumByColor = xTotal
End Function

In het werkblad de formule: =sumbycolor((celbereik;cel met referentiekleur) dus b.v. in cel B11 =sumbycolor(( B2:B10);A1). Als je B11 de tekstkleur geeft die je bedoeld mag i.p.v. A1 ook B11 geschreven worden.
Werkt uitstekend en kan nu zonder de ASAP-utilities

Een bijgewerkt model is toegevoegd.
 

Bijlagen

Laatst bewerkt:
In dit geval kun je application.volatile ook weglaten; je zet immers de cel/cellen in het genoemde bereik op herberekenen, hetgeen de UDF sowieso triggert.
Die application.volatile laat jouw UDF bij iedere wijziging in de applicatie herberekenen ;)
 
anton44 zei:
@ Eric,
Ik heb de modules ingepast in mijn doel-workbook en een aantal testen gedaan met o.a. de andere macro in het workbook, andere workbooks bijgeladen en gerund. Alles werkt perfect en zonder conflicten/problemen. Heel fijn. Ik heb weer heel wat bijgeleerd (niet dat ik deze complexe codes helemaal doorgrond hoor !)
Met enorme dank voor je inspanningen.:thumb: :thumb: :thumb:
Klik om te vergroten...

Ik ben begonnen om ook de ASAP-formules te vervangen door de UDF daarvoor.
Als ik in een kolom de formule geschreven heb en wil die doortrekken naar de andere kolommen krijg ik een foutmelding:
Bekijk bijlage 290179
de bijbehorende code:
Code: 
            If vActSelProp(i, j) <> vPreSelProp(i, j) Then
De Microsoft Help zegt daarover het volgende:
Het subscript valt buiten het bereik (Fout 9)
Zie ook Bijzonderheden

U kunt alleen binnen de gedefinieerde bereiken toegang krijgen tot matrixonderdelen en leden van collecties. Voor deze fout zijn de volgende oorzaken en oplossingen mogelijk:

U hebt verwezen naar een matrixonderdeel dat niet bestaat.
Misschien is het subscript groter of kleiner dan het bereik van mogelijke subscripts of er zijn op dit punt in de toepassing nog geen dimensies aan de matrix toegewezen. Controleer de boven- en ondergrens van de declaratie van de matrix. Gebruik de functies UBound en LBound om matrixgrenzen aan te geven als u werkt met matrices waarvan de grootte wordt gewijzigd. Controleer de spelling van de variabelennaam wanneer de index als een variabele is opgegeven.

U hebt een matrix gedeclareerd, maar u hebt het aantal matrixonderdelen niet opgegeven. Deze fout wordt bijvoorbeeld veroorzaakt door de volgende code:
Dim MyArray() As Integer
MyArray(8) = 234 ' Causes Error 9.

In Visual Basic worden niet-opgegeven matrixbereiken zoals het bereik 0 - 10 niet impliciet van een dimensie voorzien. Als u het aantal onderdelen van een matrix expliciet wilt opgeven, gebruikt u Dim of ReDim.

U hebt verwezen naar een niet-bestaand lid van een collectie.
Probeer de constructie For Each...Next te gebruiken in plaats van indexonderdelen op te geven.

U hebt een afgekorte vorm van het subscript gebruikt waarmee u impliciet een ongeldig element hebt opgegeven.
Als u bijvoorbeeld de operator ! in combinatie met een collectie gebruikt, geeft ! impliciet een sleutel op. Zo is object!sleutelnaam.waarde bijvoorbeeld equivalent aan object.onderdeel(sleutelnaam).waarde. In dit geval treedt een fout op als keyname een ongeldige sleutel is in de collectie. Gebruik een geldige sleutelnaam of index voor de collectie om de fout op te lossen.

Kun je hier iets mee ?
 
Laatst bewerkt:
Ik heb in de Klassenmodule een aanpassing (3000 was 30) gedaan en kan momenteel het probleem niet meer reconstrueren.
Is deze aanpassing verantwoord vwb het functioneren ?
Code: 
Private Const iMaxChecks As Integer = [b]3000[/b] 'Maximum number of cells in selection which can be checked, the higher the slower

Aanvulling: Probleem is toch niet helemaal opgelost met 3000 cells as max.
 
Laatst bewerkt:
deze 30 is enkel een beveiliging om bij een kopieeraktie niet eindeloos bezig te zijn om alle cellen af te gaan.
Ik kan jouw fout niet reconstrueren, ook kan ik de bijlage niet openen.
Daarnaast zou ik deze code niet laten draaien bij het 'bouwen' van jouw spreadsheet, maar juist enkel bij het gebruik.
 
Eric, ik deel je advies om de bewuste codes allen bij gebruik actief te hebben.
Hierbij heb ik dan wel wat vraagjes (alweer :0) )
1. Hoe schakel ik die uit zonder de foutmelding te riskeren ? - Ik constateer dat een wijziging in This Workbook (bv bereik) het herberekenen niet meer plaatsvindt.
2. Hoe schakel ik die weer in zonder het bestand op te slaan, af te sluiten en opnieuw te openen ?
 
tbv Punt 1 en 2:
In ThisWorkbook:
Code: 
Private Sub Workbook_Open()
  Zetaan
End Sub
Sub Zetuit()
 Set cMonitor = Nothing
End Sub
Sub Zetaan()
Set cMonitor = New ClsMonitorOnupdate
    Set cMonitor.Range = Sheets(sSheet).Range(sRanges)
End Sub

Ik zou zorgen dat je Zetuit eerst draait, voordat je het bestand afsluit. (ik denk dat bovengenoemde fout ontstaat, doordat de Class 'in leven' blijft als de Excel-Applicatie zelf niet wordt afgesloten)

++ het stukje code uit post#18 ook even toevoegen in jouw laatste versie
 
Laatst bewerkt:
All done. Het werkt prima.
Kleine aanvulling:
De nieuwe code < Private Sub Workbook_Open() enz....> komt in de plaats van de vorige versie.
Bestand in bijlage is aangepast.

Wederom hartelijk dank
 

Bijlagen

@E V R,
Eric, ik ben zeer enthousiast over het werken met alle aanpassingen en waardeer je inspanningen in zeer hoge mate :thumb:

In je 1e bijlage was de code naast de font.color ook actief voor de andere cell-properties. Later is op mijn verzoek alleen de font.color overgebleven.
Om universeel te zijn zou ik graag de aanpassingen/codes kennen voor alle cell-properties. Ik hoop dat ik niet te veel van je vraag.

Zelf heb ik een poging gewaagd om de verschillen tussen je 1e bijlage en mijn laatste te vinden maar ik constateer een wezenlijk verschil. In de 1e wordt voor een herberekening "yourmacro" gecalled terwijl die in de jongste niet meer nodig is. Ik vermoed dat het alleen draait om de codes in de Klassenmodule (?)
 
Het draait enkel om het vastleggen van de cel eigenschappen waar je naar wilt kijken. Alle? Oospronkelijk had ik dit erin zitten middels een oude Excel4macro waarbij 66 eigenschappen werden opgeslagen.
Dit opslaan doe je met de Sub GetALotOfCellPropertiesInSelection.
Deze legt de celeigenschappen vast waarop jij wilt kijken of er een wijziging in heeft plaatsgevonden.
Wil je er meer dan breidt je dit uit:

Code: 
vActSelProp(1, j) = rCell.Address(False, False)
vActSelProp(2, j) = rCell.Font.Color 
vActSelProp(3, j) = rCell.Font.Bold 
vActSelProp(4, j) = rCell.Interior.Color 
'vActSelProp(5, j) = rCell. etcetera
'vActSelProp(6, j) =en verder.....

Daarnaast pas je het nummertje aan in ReDim vActSelProp(1 To 2, 1 To Appl ( De 2 nu dus naar 6)

Die celeigenschappen moet je zelf maar even uitvogelen, (Macrootje opnemen werkt prima)

Uiteindelijk kun je ook per wijziging een aparte macro starten
 
Ik probeerde mijn berichtje weg te sturen maar moest de pagina vernieuwen waarna jouw bericht binnenkwam.
Inderdaad ik was daar ook achter gekomen. (Ben nog steeds erg enthousiast)

Mijn bericht:
@E V R,
Eric, het bleek toch eenvoudiger dan verwacht. In de Klassenmodule heb ik de redim aangepast en regel voor InteriorColor toegevoegd:

Code: 
Private Sub GetALotOfCellPropertiesInSelection()
    Dim sPathname As String, i As Integer, j As Integer, rCell As Range
   
        ReDim vActSelProp(1 To 9, 1 To Application.Min(iMaxChecks, Selection.Cells.Count)) 'detectie font-color verandering
        j = 0
        For Each rCell In Selection
            If j >= iMaxChecks Then Exit For
            j = j + 1
            vActSelProp(1, j) = rCell.Address(False, False)
            vActSelProp(2, j) = rCell.Font.Color
            vActSelProp(3, j) = rCell.Interior.Color
        Next rCell
   
End Sub
 
Je blijft mijn weetgierigheid vast te houden met Uiteindelijk kun je ook per wijziging een aparte macro starten !
Hoe ? Met een call newmacro ?

In Private Sub CheckForChangesinProperties()
for j=1 enz call newmacro: Exit For ?
 
Laatst bewerkt:
Bijv zo:
Code: 
Private Sub CheckForChangesinProperties()
    Dim i As Integer, j As Integer, sCheckString As String, sChangeString As String

    For j = 1 To Application.Min(iMaxChecks, Selection.Cells.Count)
        For i = LBound(vActSelProp) To UBound(vActSelProp)
            If vActSelProp(i, j) <> vPreSelProp(i, j) Then
            Select Case i
            Case 2: MsgBox "font color change" 'zet hier ipv de msgbox een macronaam
            Case 3: MsgBox "Cell color change" 'idem
             Case Else
             End Select
              rMonitor.Dirty: Exit For 'als er maar 1 macro gestart kan/mag worden
            End If
        Next i
    Next j
   
End Sub
 
Laatst bewerkt:
Alweer bedankt. Ik zat een beetje in de richting ;).
 
@Eric, als desert:
In ThisWorbook wordt het gebied wat gemonitord moet worden gedefinieerd - sheet en bereik.
Code: 
Option Explicit
Private Const sRanges As String = "E3:P35"
Private Const sSheet As String = "onderhoud"
Private cMonitor As ClsMonitorOnupdate
Als op eenzelfde sheet meerdere bereiken nodig zijn veronderstel ik dat die door een ; gescheiden kunnen worden.
Maar hoe als er bereiken van verschillende sheets gewenst zijn ?
 
Oorspronkelijk werd dit vastgelegd in de sheet zelf, middels het activate - event. Dan kun je per sheet een bereik opgeven (normaliter werk je ook maar op 1 sheet tegelijkertijd) Omdat je wilde dat het meteen werkte heb ik eea in ThisWorkbook gezet.

Ik zou dus (als je dit in meerdere sheets wilt) de monitoring aanzetten in het activate-event van de betreffende sheet, en uitzetten middels het deactivate-event

Dan enkel nog de code in ThisWorkbook aanpassen om bij opening de monitoring ook meteen aan te zetten.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan