Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: Aangepast lint in Excel  (gelezen 5047 keer)

0 leden en 1 gast bekijken dit topic.

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Aangepast lint in Excel
« Gepost op: 06 augustus 2022, 07:00:53 »
Goedemorgen iedereen,

Voor een groot borduur-project (als huwelijkscadeau voor mijn oudste dochter) heb ik excel gebruikt voor het ontwerpen van mijn borduurpatroon (= dus een uniek patroon).
De eerste macro die ik geschreven heb was om het aantal steken per symbool (kleur) te tellen zodat ik kon berekenen hoeveel borduurgaren ik van elke kleur nodig had.

Vervolgens heb ik nog enkele macro’s geschreven om de vordering van het borduurwerk snel en makkelijk te markeren op het patroon binnen excel.
Omdat ik de opdrachtknoppen onmogelijk op het werkblad zelf (telpatroon) kon plaatsen heb ik op het lint een extra tabblad aangemaakt waarop ik alle opdrachtknoppen heb geplaatst.

Dit is allemaal vlekkeloos verlopen.
Echter, bij elk (nieuw) excel-bestand dat ik open krijg ik dat extra tabblad met opdrachtknoppen op het lint.
Op zich is dit niet zo een héél groot probleem maar het is wel lichtjes storend om in al mijn andere bestanden, die totaal niets met borduren te maken hebben, een tabblad ivm borduren op het lint te hebben.

Mijn vraag : Is er een manier om dat extra tabblad enkel maar in het borduur-bestand te hebben?
Alvast mijn oprechte dank.

Groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #1 Gepost op: 06 augustus 2022, 09:16:24 »
Hallo BlackDevil,

Mijn kennis daaromtrent is niet al te groot, maar ik denk dat het niet kan op de manier die jij in gedachten hebt (die extra tab enkel in dat ene bestand laten bestaan).
Wat ik wel weet is dat je tabs naar wens zichtbaar of onzichtbaar kan maken, ook via vba.
De logica gebiedt mij dan om je te adviseren die tab standaard verborgen te zetten (manueel dus), en hem in je borduurfile met vba zichtbaar te maken bij openen. Hoe dat precies moet zou ik zelf ook moeten uitzoeken (ik kijk straks wel eens, misschien jij ondertussen ook?)
Op de vraag of hij bij sluiten van het bestand terug verborgen moet worden zal ik ook nog het antwoord moeten zoeken...

Mvg,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #2 Gepost op: 06 augustus 2022, 10:11:46 »
Hey MollyVH,

Alvast bedankt voor het meedenken/meezoeken.

En ja, ik had al een vermoeden dat het niet mogelijk ging zijn zoals bij de snelle toegang (waar je kan toevoegen voor één specifiek bestand).
Maar de tab standaard verbergen is "the next best thing" wat mij betreft.
Ben net terug van een 2u-durende autorit dus moet eventjes bekomen (hernia's en neuropathie) maar ik ga zo meteen zeker ook eens uitzoeken
hoe het juist aangepakt moet worden.

Zodra ik iets vind zal ik het zeker hier melden.

groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #3 Gepost op: 06 augustus 2022, 10:28:59 »
Hallo BlackDevil,

Ik heb zelf ook meerdere weken fysiek in de lappenmand gelegen en ben momenteel nog maar beetje bij beetje terug overeind aan het krabbelen. Daardoor heb ik mijn plan om eindelijk een nieuwere Office-versie aan te schaffen nog steeds niet kunnen uitvoeren, en daar bij mij het lint niet aan te passen valt lijkt het mij héél waarschijnlijk dat jij het eerder zal vinden dan ik. Succes !!

Mvg,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #4 Gepost op: 06 augustus 2022, 11:33:41 »
Hey MollyVH,

Oei, klinkt ook niet zo best... Alvast snel beterschap gewenst...

Van al wat ik ondertussen heb gevonden op het internet blijkt dat één specifiek tabblad tonen/verbergen enkel handmatig in een bestand mogelijk is, via VBA zou het geenszins mogelijk zijn.

Wel heb ik hier -> https://www.snb-vba.eu/VBA_Lint.html iets gevonden dat interessant lijkt voor mij aangezien ik ook nog andere geautomatiseerde excel-bestanden heb (mbt mijn genealogie, huishoudboekhouding, enz...) waarbij gepersonaliseerde tabs op het lint veel handiger zouden zijn.
Ik heb alles gedownload en geïnstalleerd zoals vermeld op de site maar bots echter tegen het probleem dat de macro, in het gedownloade excel-bestand, aangepast moet worden voor een 64-bits systeem.
Spijtig genoeg heb ik absoluut geen verstand van hoe ik een macro alzo moet aanpassen.

Dus voorlopig zal ik het vrees ik gewoon moeten blijven doen met de extra tab in elk bestand.

groetjes,
BlackDevil

1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #5 Gepost op: 06 augustus 2022, 16:58:56 »
Hallo BlackDevil,

Citaat
Van al wat ik ondertussen heb gevonden op het internet...via VBA zou het geenszins mogelijk zijn
Ik was er nochtans zeker van dat ik dat vroeger eens ben tegengekomen. Waarschijnlijk zijn mijn hersenen (of minstens het gedeelte verantwoordelijk voor onthouden) dus ook aangetast.
Ik kon het niet laten even je link te volgen en dat is inderdaad niet van het simpelste...
Maar ondertussen blijft het wel kriebelen, de kans is dus groot dat ik later (voel je niet schuldig, het zal dan vooral voor mezelf zijn) nog verder speur.
Gelukkig kan je in elk geval gewoon verder!

Groetjes,
Molly

Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #6 Gepost op: 12 augustus 2022, 15:48:19 »
Goedenamiddag iedereen,

Ik heb nog een extra vraagje mbt hetzelfde bestand uit de initiële vraag, vandaar dat ik mijn bijkomende vraag hier plaats.

Ik heb dus meerdere macro’s geschreven om binnen excel mijn borduurpatroon bij te werken naarmate mijn borduurwerk vordert.
Nu, al deze macro’s doen exact wat ze moeten doen maar er is er eentje die redelijk wat tijd in beslag neemt om te doorlopen (waarbij ik boven het lint plots gedurende een 10-tal seconden “reageert niet” zie verschijnen).
Ik vermoed dus dat mijn macro qua snelheid niet zo goed is opgebouwd en daarom wou ik aan de kenners hier eventjes vragen hoe ik mijn macro best kan aanpassen zodat de ‘vertraging’ niet langer of minimaal optreedt.

Omdat ik mijn origineel bestand niet kan bijvoegen, maar het doel van de macro beter te begrijpen is met een voorbeeld, heb ik snel even een verkleinde versie gemaakt welk ik hier aanhang (de macro staat in de module "mod_afgewerkt").
In het voorbeeldbestand telt het patroon maar 20 rijen en 20 kolommen en worden er maar 3 kleuren gebruikt, waardoor hier de vertraging niet optreedt.
In het originele bestand telt het patroon 270 rijen en 216 kolommen en worden er 29 kleuren gebruikt.
De betreffende macro heeft als doel om een visuele controle in kleur te kunnen uitvoeren tov mijn werkelijk borduurwerk om sneller na te kunnen gaan dat ik geen fouten heb gemaakt.

Alvast dank op voorhand voor raad, tips en eventueel meedenken.

Groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #7 Gepost op: 12 augustus 2022, 16:15:45 »
Hallo BlackDevil,

Aangezien we met maar een fractie van het grote bestand aan de slag moeten valt het moeilijk in te schatten hoeveel we hiermee gaan winnen (mogelijk kunnen we nog een stapje verder gaan), maar probeer alvast eens zonder 'Select'.

Sub afgewerkt()
Application.ScreenUpdating = False
  '----- nagaan welke cellen (borduursteken) reeds gemarkeerd (geborduurd) zijn
  With Sheets("patroon")
    For rij = 1 To 20
      For kol = 1 To 20
        If .Cells(rij, kol).Interior.Color = vbGreen And .Cells(rij, kol) <> "" Then
          symbool = .Cells(rij, kol)
          '----- corresponderende kleur zoeken nav symbool
          With Sheets("DMCtoRGB")
            For i = 2 To 4
              If .Cells(i, 6) = symbool Then
                R = .Cells(i, 2)
                G = .Cells(i, 3)
                B = .Cells(i, 4)
                '----- de gemarkeerde cellen (borduursteken) omzetten in kleur naar extra werkblad
                With Sheets("afgewerkt")
                  'arij = rij
                  'akol = kol
                  '.Cells(arij, akol).Select
                  With .Cells(rij, kol)
                    .Borders(xlDiagonalDown).LineStyle = xlContinuous
                    .Borders(xlDiagonalDown).Color = RGB(R, G, B)
                    .Borders(xlDiagonalDown).Weight = 4
                    .Borders(xlDiagonalUp).LineStyle = xlContinuous
                    .Borders(xlDiagonalUp).Color = RGB(R, G, B)
                    .Borders(xlDiagonalUp).Weight = 4
                  End With
                End With
              End If
            Next i
          End With
        End If
      Next kol
    Next rij
  End With
Application.ScreenUpdating = True
End Sub


Mvg,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #8 Gepost op: 12 augustus 2022, 16:30:18 »
Vervolg: over 29 kleuren had ik heen gelezen, dus meteen nog wat ingekort:

Sub afgewerkt()
Application.ScreenUpdating = False
  '----- nagaan welke cellen (borduursteken) reeds gemarkeerd (geborduurd) zijn
  With Sheets("patroon")
    For rij = 1 To 20
      For kol = 1 To 20
        If .Cells(rij, kol).Interior.Color = vbGreen And .Cells(rij, kol) <> "" Then
          symbool = .Cells(rij, kol)
          '----- corresponderende kleur zoeken nav symbool
          With Sheets("DMCtoRGB")
            'For i = 2 To 4
              'If .Cells(i, 6) = symbool Then
              i = .Columns(6).Find(symbool).Row
              R = .Cells(i, 2)
              G = .Cells(i, 3)
              B = .Cells(i, 4)
            'Next i
          End With
        '----- de gemarkeerde cellen (borduursteken) omzetten in kleur naar extra werkblad
            With Sheets("afgewerkt").Cells(rij, kol)
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Color = RGB(R, G, B)
                .Borders(xlDiagonalDown).Weight = 4
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalUp).Color = RGB(R, G, B)
                .Borders(xlDiagonalUp).Weight = 4
            End With
        End If
      Next kol
    Next rij
  End With
'Application.ScreenUpdating = True
End Sub
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #9 Gepost op: 12 augustus 2022, 17:27:56 »
Hey MollyVH,

Hartelijk dank voor jouw aanpassingen  _/-\o_.
Hiermee is de 'vertraging' toch al gehalveerd en de melding "reageert niet" verschijnt ook al niet meer, dus zeker en vast al een heuse verbetering  :thumbsup:.

Momenteel heb ik wel nog maar een 30-tal rijen van de 270 effectief afgewerkt dus ik vermoed wel naarmate er meer rijen zullen afgewerkt zijn dat er zich dan sowieso een toename van de 'vertraging' zal voordoen. Moest dit dan echt een té grote vertraging veroorzaken dan meld ik het hier wel.

Groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #10 Gepost op: 12 augustus 2022, 18:03:54 »
Hallo BlackDevil,

Enkel gehalveerd? Dat is natuurlijk niet goed genoeg!
Dan laten we 'standaard aanpassen' achter ons en schakelen over naar 'meedenken'  :)

Voor zover ik kan volgen: eens een cel groen is zal ze altijd groen blijven?
Wat nu nog gebeurt is dat telkens het volledige blad 'afgewerkt' hertekend wordt. Dat zou, als mijn vorige veronderstelling klopt, overbodig zijn.
Wat we dus kunnen doen (en dat wordt eenvoudig omdat elke cel op 'afgewerkt' overeenkomt met dezelfde op 'patroon') is iets zetten op 'afgewerkt'. Ik zou dan resoluut voor een spatie gaan. Of een cel moet behandeld worden hangt dan niet enkel af van het feit dat ze groen is maar ook als diezelfde cel op 'afgewerkt' leeg is.
Volg je nog een beetje?

Met deze code krijg je dat volgens mij in orde. Uitsluitend de eerste keer zal het dus nog even lang duren. Probeer je eens?

Sub afgewerkt()
Application.ScreenUpdating = False
  '----- nagaan welke cellen (borduursteken) reeds gemarkeerd (geborduurd) zijn
  With Sheets("patroon")
    For rij = 1 To 20
      For kol = 1 To 20
        'ook kijken of de cel op 'afgewerkt' leeg is
        If .Cells(rij, kol).Interior.Color = vbGreen And .Cells(rij, kol) <> "" _
         And Sheets("afgewerkt").Cells(rij, kol) = "" Then
          symbool = .Cells(rij, kol)
          '----- corresponderende kleur zoeken nav symbool
          With Sheets("DMCtoRGB")
              i = .Columns(6).Find(symbool).Row
              R = .Cells(i, 2)
              G = .Cells(i, 3)
              B = .Cells(i, 4)
          End With
        '----- de gemarkeerde cellen (borduursteken) omzetten in kleur naar extra werkblad
            With Sheets("afgewerkt").Cells(rij, kol)
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Color = RGB(R, G, B)
                .Borders(xlDiagonalDown).Weight = 4
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalUp).Color = RGB(R, G, B)
                .Borders(xlDiagonalUp).Weight = 4
            End With
            'en hier een spatie zetten om dat blad 'proper' te houden
            Sheets("afgewerkt").Cells(rij, kol) = " "
        End If
      Next kol
    Next rij
  End With
'Application.ScreenUpdating = True
End Sub

Suggestie: probeer deze code (op een kopie van je bestand toch maar), zorg daarna voor wat extra groen en voer de code nogmaals uit (met de chronometer in de hand?)

Groetjes,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #11 Gepost op: 13 augustus 2022, 09:11:40 »
Hey MollyVH,

Bedankt voor de extra tijd dat je investeert in het ‘meedenken’.
Ik heb de code uit je laatste bericht uitgetest en pijtig genoeg is er nog steeds een ‘vertraging’…
Het is te zeggen, het onderdeel ‘wegschrijven’ naar werkblad “afgewerkt” gaat vrij snel maar het is volgens mij het ‘inlezen’ van het werkblad “patroon” dat voor de vertraging zorgt.

Daarom ben ik aan het denken geweest om misschien de buitenste loop (voor het doorlopen van de rijen) te laten variëren. Wat ik hiermee bedoel is om eerst de eerste rij te laten zoeken die een groen ingekleurde cel bevat en dan dat rijnummer vast te leggen met een variabele die we dan gebruiken om die buitenste loop te starten.
De binnenste loop (voor de kolommen te doorlopen) dient sowieso altijd “1 To 216” te zijn.
Maar als we de buitenste loop (voor de rijen) kunnen inkorten zal het inlezen volgens mij toch wel aanzienlijk wat minder tijd in beslag nemen.
Aangezien ik met mijn borduurwerk onderaan ben begonnen en alzo naar boven werk is het niet nodig dat de loop elke keer op rij 1 start. Met wat ik ingedachte heb zou de loop dan “start To 270” zijn.
Alleen weet ik niet goed hoe ik moet zoeken naar die eerste rij die een cel met groene achterkleur bevat en dit vervolgens kan laten vastleggen in een variabele.

Om nog een stapje verder te gaan dacht ik om eventueel de stoprij te laten bepalen door op het werkblad “afgewerkt” na te gaan welke de eerste rij is met 216 cellen die als waarde een spatie hebben en dan dat rijnummer -1 kan dan de stop-variabele zijn voor die buitenste loop. Maar misschien is dit dan weer té ver gezocht? 

Ik heb aan jouw laatste code-blokje wel een zéér kleine aanpassing gemaakt zodat ook de groene cellen die geen waarde bevatten op werkblad “patroon” dan op het werkblad “afgewerkt” ook een spatie krijgen.

Sub afgewerkt()
Application.ScreenUpdating = False
  '----- nagaan welke cellen (borduursteken) reeds gemarkeerd (geborduurd) zijn
  With Sheets("patroon")
    For rij = 1 To 20
      For kol = 1 To 20
        'ook kijken of de cel op 'afgewerkt' leeg is
        If .Cells(rij, kol).Interior.Color = vbGreen Then
          If .Cells(rij, kol) <> "" And Sheets("afgewerkt").Cells(rij, kol) = "" Then
            symbool = .Cells(rij, kol)
            '----- corresponderende kleur zoeken nav symbool
            With Sheets("DMCtoRGB")
                i = .Columns(6).Find(symbool).Row
                R = .Cells(i, 2)
                G = .Cells(i, 3)
                B = .Cells(i, 4)
            End With
        '----- de gemarkeerde cellen (borduursteken) omzetten in kleur naar extra werkblad
            With Sheets("afgewerkt").Cells(rij, kol)
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Color = RGB(R, G, B)
                .Borders(xlDiagonalDown).Weight = 4
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalUp).Color = RGB(R, G, B)
                .Borders(xlDiagonalUp).Weight = 4
            End With
          End If
          'en hier een spatie zetten om dat blad 'proper' te houden
          Sheets("afgewerkt").Cells(rij, kol) = " "
        End If
      Next kol
    Next rij
  End With
'Application.ScreenUpdating = True
End Sub


Groetjes,
BlackDevil

1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #12 Gepost op: 13 augustus 2022, 11:42:15 »
Hallo BlackDevil,

Dat is inderdaad nog steeds slechter dan ik had gehoopt. Dus heb ik je voorbeeldbestand uitgebreid naar het correcte aantal rijen, kolommen en kleuren (wees gerust: dat heeft niet lang geduurd) en wat metingen uitgevoerd.

De conclusie kan alleen zijn dat een andere aanpak moet gezocht worden, maar ik zou het (weeral) zo eenvoudig mogelijk houden.
Citaat
Alleen weet ik niet goed hoe ik moet zoeken naar die eerste rij die een cel met groene achterkleur bevat
Ik vrees dat het daardoor opnieuw lang gaat duren want dan moet je ook alles aflopen.

Waar ik daarom aan denk: je werkblad 'patroon' wil je uiteraard niet verprutsen, dus we bewaren het origineel en voegen een kopie als werk-werkblad :) toe.

Dan zou ik vervolgens de rijen van onder naar boven analyseren. Er zijn dan 3 mogelijkheden:
1. geen enkele groene cel: de macro mag stoppen
2. groene en witte cellen: die rij wordt verwerkt zoals tot nu
3. enkel groene cellen: die rij wordt verwerkt en daarna verwijderd (hoor ik daar een 'oei'?)
Rond dat geheel moeten we nog enkel de macro laten starten op de laatste rij (ipv rij 270)

Eén belangrijke voorwaarde is er wel: kan het dat een rij volledig groen is terwijl er meer naar onder een rij staat die NIET volledig groen is? Want dan zouden we een extra controle moeten inbouwen.
Tenminste ik neem ook aan (ivm mogelijkheid 1) dat hoger dan een volledig witte rij niets groen kan staan(?), anders zitten we met 2 voorwaarden...

Groetjes,
Molly

Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

Offline BlackDevil

  • Ambassadeur
  • *****
  • Berichten: 1.029
  • Geslacht: Vrouw
  • veni vidi vici
Re: Aangepast lint in Excel
« Reactie #13 Gepost op: 13 augustus 2022, 12:53:13 »
Hey MollyVH,

Hartelijk dank voor je reactie.
En ja inderdaad, ivm wat ik in gedachten had zou in eerste instantie er opnieuw een volledige 'doorloop' plaatsinden wat ik dus net wou vermijden.
Daarom dacht ik om eventueel op beide werkbladen een (verborgen) "hulp-kolom" (kolom 220 ofzo) te plaatsen en aldaar dmv een formule het aantal betreffende cellen te tellen. Met betreffende cellen bedoel ik voor werkblad "patroon" de groen gekleurde cellen en voor werkblad "afgewerkt" de cellen die een spatie bevatten.
Op die manier zou dan de beginrij kunnen gezet worden op het rijnummer van de eerste cel in de hulpkolom ("patroon") waarbij de waarde groter is dan 0 en de eindrij kunnen gezet worden op het rijnummer -1 van de eerste cel in de hulpkolom ("afgewerkt") met waarde 20 (of 216 in het originele bestand).
Op die manier moet er dan maar 2x één kolom doorlopen worden om begin en einde van die buitenste loop te bepalen. Maar dat wordt dan misschien allemaal wel té omvangrijk... Ik vond trouwens niet meteen hoe ik de cellen op basis van de achtergrondkleur via een formule kon laten tellen.

Wat je voorstelt zou inderdaad een goede oplossing zijn aangezien er nooit een onvolledige groene rij zal staan onder een volledige groene rij.
Er is echter wel 1 klein probleempje met deze manier (en dan louter op praktisch vlak voor mezelf) en dat is dat ik me vaak moet baseren op reeds geborduurde rijen om de eerstvolgende steek makkelijker te vinden. Mijn beeldscherm staat op ca. 1m van waar ik zit om te borduren dus het visuele is redelijk belangrijk  ;D.
Maar sowieso de rijen van onder naar boven overlopen en daarbij puntje 1 en 2 toepassen zie ik helemaal zitten.
Maar het derde puntje zou ik, indien mogelijk, ipv de rij te verwijderen dan liever een andere optie willen zoeken om deze niet meer op te nemen in de volgende doorloopronde.

Nogmaals mijn oprechte dank voor al jouw input  :thumbsup:.

groetjes,
BlackDevil
1) HP ProDesk (Windows 10 Pro Edu / Intel(R) Core(TM) i5-7500 CPU@ 3.40Ghz 3.41Ghz)
2) Laptop ASUS (Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz)
Beide (RAM : 8,00 GB / 64-bits besturingssysteem, x64-processor)
Extern (Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP ENVY 6030e)
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Oplosser
  • *****
  • Berichten: 847
Re: Aangepast lint in Excel
« Reactie #14 Gepost op: 13 augustus 2022, 13:08:17 »
Hallo BlackDevil,

OK, het zal niet te lastig zijn om ons beider ideeën te verenigen. Zet eerst en vooral eens manueel (eenmalig dus) een 'x' in HL271, en dan zou het daarna met deze code goed moeten gaan:
Sub afgewerkt_test()

Start = Timer

Application.ScreenUpdating = False
  '----- nagaan welke cellen (borduursteken) reeds gemarkeerd (geborduurd) zijn
  With Sheets("patroon")
    markeren = True 'uitgangspunt is dat we volledige groene rijen vinden, dus ze mogen gemarkeerd worden
    beginnen = .Columns(220).Find("x").Row - 1
    For rij = beginnen To 1 Step -1
      'aantal groene initialiseren en tellen
      groene = 0
      For kol = 1 To 216
        If Cells(rij, kol).Interior.Color = vbGreen Then groene = groene + 1
      Next kol
      If groene < 216 Then markeren = False 'we moeten stoppen met markeren
      If groene = 0 Then Exit For 'volledige rij witte gevonden
     
      For kol = 1 To 216
        If .Cells(rij, kol).Interior.Color = vbGreen And .Cells(rij, kol) <> "" Then
          symbool = .Cells(rij, kol)
          '----- corresponderende kleur zoeken nav symbool
          With Sheets("DMCtoRGB")
              i = .Columns(6).Find(symbool).Row
              R = .Cells(i, 2)
              G = .Cells(i, 3)
              B = .Cells(i, 4)
          End With
        '----- de gemarkeerde cellen (borduursteken) omzetten in kleur naar extra werkblad
            With Sheets("afgewerkt").Cells(rij, kol)
                .Borders(xlDiagonalDown).LineStyle = xlContinuous
                .Borders(xlDiagonalDown).Color = RGB(R, G, B)
                .Borders(xlDiagonalDown).Weight = 4
                .Borders(xlDiagonalUp).LineStyle = xlContinuous
                .Borders(xlDiagonalUp).Color = RGB(R, G, B)
                .Borders(xlDiagonalUp).Weight = 4
            End With
        End If
      Next kol
     
      If groene = 216 And markeren = True Then 'dubbele controle of we een 'x' mogen zetten
        Cells(rij, 220) = "x"
      End If
    Next rij
  End With
 
MsgBox (Timer - Start & " sec.")

End Sub

Groetjes,
Molly
Windows 11 Home NLD 64bit
11th Gen Intel(R) Core(TM) i7-11700 @ 2.50GHz 2496
Aspire TC-1660
Intel(R) UHD Graphics 750 1024MB
476 GB SSD KINGSTON OM8PCP3512F-AA
1863 GB HD Seagate ST2000DM008-2FR102
Office 2021 Professional Plus NLD 64bit

 


www.combell.com