Hoe zwaar is de camerafunctie van Excel?

[snb]

Gebruik svp de goede knop voor een reaktie: niet steeds de citeerknop.

Om code te begrijpen:
- analyseren
- In stukken opdelen
- afzonderlijk testen
- onbekende termen selekteren in op F1 in de VBEditor klikken
- onbekende elementen opzoeken in de object browser van de VBEditor

Omdat je ons de informatie over de 100+ gebieden onthoudt, is het voor ons verspilde moeite om alle tig-verschillende mogelijkheden om dit in 1 VBA code te realiseren te tonen, laat staan die afzonderlijk uit te leggen.
Er wordt nu eerst inzet/werk van jouw kant verwacht.

 

[huijb]

@ grietsenwijma: Als je nog een keer aan de quote komt sluit ik dit topic. Heb inmiddels vele onnodige quotes van je verwijderd. Als je direct op een antwoord reageert hoef je niet, ik herhaal niet te quoten.

 

[AD1957]

Zonder een gedegen voorbeeldbestand(met uitleg wat je nu precies wilt bereiken) is het maar koffiedik kijken.

 

[grietsenwijma]

Sorry voor dat gequote, ik dacht dat ik de draad er daarmee beter in zou houden.
Zal niet meer gebeuren

 

[grietsenwijma]

Nogmaals excuus voor het quoten.

Ik begrijp dat mijn vraagstelling moeilijk te volgen is. Heeft er vooral mee te maken dat ik aan de hand van de antwoorden steeds nieuwe en andere mogelijkheden zag.
Het is nu bij mij wel zo'n beetje uitgekristalliseerd hoe het bij ons mooi zou kunnen.
Ik heb ook even wat moeite gedaan om een uitgebreider voorbeeldbestand te maken. De structuur van dit voorbeeldbestand is eigenlijk in grote lijn zoals ik het bijna 20 jaar geleden aantrof toen ik bij dit bedrijf begon.
Een calculatieprogramma waarbij er op het werkblad "begroting" wordt gerekend en dit zich op het werkblad "Offerte" vertaalt in een aanbieding. (de gele tekstdelen zijn het te printen deel.)

Dit programma is door de jaren heen vervuild geraakt door diverse aanpassingen, verbouwinkjes en de overgangen van office 97 naar2007 naar2016 naar 365
Vandaar het plan om "schoon" opnieuw te beginnen
De werk- en denkstructuur op zich staat bij de collega’s overigens niet ter discussie, met iets fundamenteel anders bouwen ga ik geen vrienden maken.

In dit voorbeeld heb ik 2 hoofdstukjes van de begroting en het corresponderend deel van de offerte uitgewerkt.
In zijn volledige vorm gaat het dus om 100+ van dit soort stukjes tekst waarvan er afhankelijk van het soort van project een deel gebruikt wordt

Ik heb één en ander nu zo ingericht zoals ik het ongeveer voor ogen heb.
Wat ik zoek is dat ik dus steeds als ik in een hoofdstukje begroting werk de camerapositie van het bijbehorende tekstdeel van de offerte in beeld krijg. (zoals ik nu met een “vast” cameraplaatje heb gesuggereerd )
Dat zou een enorme verbetering geven in gebruikersgemak en overzichtelijkheid ten opzichte van nu waarin je steeds van werkblad moet wisselen.

Ik hoop dat ik zo mijn probleemstelling goed heb verduidelijkt en ik dank ieder vast voor het meedenken

tenminste.... als je er na die uitbranders nog zin in hebt...

 

[alphamax]

Na iii's in werkblad "aanbieding", kolom "a", volgen altijd eee's?
Volgen na die eee's soms weer 1 or meerdere iii's en eee's?
Je kan pas losliggende gebieden/regions maken als je er witregels tussen maakt!

 

[grietsenwijma]

Ik snap wat je bedoelt, als dat nodig is om het principe werkbaar te krijgen is is dat geen enkel probleem.

 

[Enigmasmurf]

Ben per ongeluk ook in dit draadje terechtgekomen. Als ik tenminste correct inschat wat je wil moet je hiermee een eindje komen.
Er is wel één flauw trucje aan te pas moeten komen: op 'Aanbieding' staat helemaal onderaan een 'fictief' hoofdstuk.
Trouwens ook een paar Select's die op dit forum meestal niet op gejuich worden onthaald.

 

[snb]

Toegepast met benoemde gebieden.
Aangevuld met:
- positie van het cameravak
- hoogte van het cameravak

 

[grietsenwijma]

Ik geloof dat ik nu vind wat ik zocht
Heel verhelderende zoektocht was het, mijn eerste idee was om 2 werkbladen van 1 werkboek tegelijk te openen zodat je realtime kon zien wat het ene blad in het andere uithaalde
Dat bleek mogelijk te zijn, maar de optie van de camerafunctie gaf een hele nieuwe draai aan mijn zoektocht.
Ik geloof dat ik er nu ben, zij het met een heel ander soort van oplossing dan ik oorspronkelijk zocht. (dat is het leuke van dit soort "open" puzzels.)

snb en Enigmasmurf bedankt voor je hulp.

Van beide heb ik een werkbaar oplossingsvoorbeeld ontvangen. Ik denk dat ik de oplossing van snb ga integreren.
Deze hangt het cameraplaatje namelijk ter hoogte van het werkgebied.
Bij de Enigmasmurf oplossing komt dit plaatje altijd boven in het document (....maar die is daar vast ook wel op aan te passen.)

Bedankt jullie 2!

En mijn stelling dat in Excel alles kan, het alleen de kunst is om uit te vinden hoe, staat nog steeds als een huis!

Ik ga de vraag als opgelost markeren.

 

[AD1957]

Probeer deze eens, dan hoef je geen +100 statische bereiken aan te maken.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If LCase(Left(Target.CurrentRegion.Cells(1), 5)) = "hoofd" Then
    
    zoek = Target.CurrentRegion.Cells(1)
    Set c = Sheets("Aanbieding").Columns(2).Find(zoek, LookIn:=xlValues)
  
        If Not c Is Nothing Then
            Dim checkCell As Range
            Set checkCell = c.Offset(1)
            
            If Target.Column > 1 And Target.Column < 7 Then
                Do While Not Left(checkCell, 5) = "Hoofd" And Not checkCell = ""
                    Set checkCell = checkCell.Offset(1, 0)
                    j = checkCell.Row - 1
                Loop

                With Sheets("Aanbieding")
                    Set Rng = .Range(.Cells(c.Row, 2), .Cells(j, 4))
                End With
                
                'verwijder het benoemd bereik
                On Error Resume Next 'voor als range("Bereik") niet bestaat
                ThisWorkbook.Names("Bereik").Delete
                ThisWorkbook.Names.Add Name:="Bereik", RefersTo:=Rng
            
                c00 = Application.Names("Bereik").RefersTo
                If Sheet1.Shapes(1).OLEFormat.Object.Formula <> c00 Then
               
                    If Sheet1.Shapes(1).OLEFormat.Object.Formula <> c00 Then Sheet1.Shapes(1).OLEFormat.Object.Formula = c00
                    Sheet1.Shapes(1).Top = Target.CurrentRegion.Cells(1).Top
                    Sheet1.Shapes(1).Height = Rng.Height
                End If
            End If
        End If
    
    
    End If
End Sub

 

[grietsenwijma]

...en al de derde werkende oplossing!

Mooie hiervan is inderdaad dat je niet met de hand al die bereiken hoeft definiëren.

Ik ben hier een mooie stap verder mee.

Heel erg bedankt!

Ik ga de vraag nu als opgelost markeren.

 

[grietsenwijma]

Ik ben al een poos aan het puzzelen met de code van AD1957

Ik heb hem op een aantal punten al aangepast naar mijn uiteindelijke toepassing (opmerkingen er uit moet nog)
Maar ik krijg hem uitstekend werkend op het voorbeeld, maar niet op de uiteindelijke toepassing
Ik heb uiteindelijk het voorbeeld maar zoveel mogelijk aangepast zodat dat qua structuur (aantal kolommen, naamgeving etc.) identiek werd aan mijn toepassing. (ik dacht dat ik dan vanzelf het pijnpunt tegen zou komen) Maar het voorbeeld blijft gewoon werken en het doeldocument blijft steeds halverwege hangen in een fout waar ik maar geen vinger achter krijg.

Zie onderstaande (aangepaste) code;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If LCase(Left(Target.CurrentRegion.Cells(1), 1)) = "§" Then
    
    zoek = Target.CurrentRegion.Cells(1)
    Set c = Sheets("Aanbieding").Columns(2).Find(zoek, LookIn:=xlValues)
  
        If Not c Is Nothing Then
            Dim checkCell As Range
            Set checkCell = c.Offset(1)
            
            If Target.Column > 1 And Target.Column < 7 Then
                Do While Not Left(checkCell, 1) = "§" And Not checkCell = ""
                    Set checkCell = checkCell.Offset(1, 0)
                    j = checkCell.Row - 1
                Loop

                With Sheets("Aanbieding")
                   
                    
                    Set Rng = .Range(.Cells(c.Row, 2), .Cells(j, 11))
                End With
                
                'verwijder het benoemd bereik
                On Error Resume Next 'voor als range("Bereik") niet bestaat
                ThisWorkbook.Names("Bereik").Delete
                ThisWorkbook.Names.Add Name:="Bereik", RefersTo:=Rng
            
                c00 = Application.Names("Bereik").RefersTo
                If Sheet1.Shapes(1).OLEFormat.Object.Formula <> c00 Then
               
                    If Sheet1.Shapes(1).OLEFormat.Object.Formula <> c00 Then Sheet1.Shapes(1).OLEFormat.Object.Formula = c00
                    Sheet1.Shapes(1).Top = Target.CurrentRegion.Cells(1).Top
                    Sheet1.Shapes(1).Height = Rng.Height
                End If
            End If
        End If
    
    
    End If
End Sub

Als ik excel een foutopsporing laat doen blijft die hangen op het volgende stukje:

Set Rng = .Range(.Cells(c.Row, 2), .Cells(j, 11))

Wie heeft enige suggestie wat ik zou kunnen proberen?
Alvast dank!

 

[AD1957]

En het bestand waar het fout gaat ?

 

[grietsenwijma]

Had ik er niet bij gedaan, nogal bedrijfsspecifiek
.....maar omdat ik nog in de prille opzet zit en het om nog maar een paar % van de uiteindelijke omvang gaat was het uiteindelijk ook maar simpel om de boel even te strippen.

Zie bijlage!

.....en haast je niet voor mij, ik kan gerust tot volgend jaar wachten

 

[AD1957]

Begin eens met het verwijderen van alle samengevoegde cellen, met VBA geven die problemen.
Ik heb wat commentaar gezet op de bladen. (zie gele vakken)
In de code ook wat commentaar geplaatst en een regel "target.currentregion.select"
Zelf ga ik het bestand niet helemaal aanpassen, werkt nu "meestal" als je in kolom C klickt.
Verdiep je eens wat CurrentRegion precies inhoud dan begrijp je ook waarom klick in kolom C meestal werkt.
Terug naar de tekentafel en succes in het nieuwe jaar.

 

[snb]

Er is nog veel voorbereidend werk aan de winkel:

Draai eens:

Sub M_snb()
   MsgBox Blad1.Cells.FormatConditions.Count

    For Each it In Blad1.UsedRange
      y = y - it.MergeCells
    Next
    MsgBox y
End Sub

- gebruik nooit samengevoegde cellen in Excel.
- de letters in de kolommen A lijken mij overbodig
- Het vastleggen van 100+ benoemde gebieden kun je met 1 simpele macro éénmalig uitvoeren; als dat bij iedere wijziging in een werkblad gebeurt (zoals in de suggeestie van AD) is dat de inefficiëntste manier.

 

[AD1957]

Mijn kennis van VBA is nog niet 1% van snb
Het zal zeker allemaal veel beter kunnen, voor mij is het nog steeds zoeken en proberen.

Toch nog een optie en ik zal het aan snb of iemand anders met meer kennis van VBA moeten overlaten om de code te verbeteren/optimaliseren etc.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Row > 10 Then
     Dim zoekCell As Range
     Set zoekCell = Cells(Target.Row, 3)
        Do While Not Left(zoekCell, 1) = "§"
            Set zoekCell = zoekCell.Offset(-1, 0)
            i = zoekCell.Row
        Loop
    
        Set c = Sheets("Aanbieding").Columns(2).Find(zoekCell, LookIn:=xlValues)
    
            If Not c Is Nothing Then
                Dim checkCell As Range
                Set checkCell = c.Offset(1)
    
                If Target.Column > 2 And Target.Column < 19 Then
                    Do While Not Left(checkCell, 1) = "§" 'And Not checkCell = ""
                        Set checkCell = checkCell.Offset(1, 0)
                        j = checkCell.Row - 1   
                    Loop
    
                    With Sheets("Aanbieding")
                        Set Rng = .Range(.Cells(c.Row, 2), .Cells(j, 11))    
                    End With

                    'verwijder het benoemd bereik
                    On Error Resume Next 'voor als range("Bereik") niet bestaat
                    ThisWorkbook.Names("Bereik").Delete
                    ThisWorkbook.Names.Add Name:="Bereik", RefersTo:=Rng
    
                    c00 = Application.Names("Bereik").RefersTo
    
                    With Sheets("Begroting")
                      If .Shapes(4).OLEFormat.Object.Formula <> c00 Then 'shape(4)!!!!!!!!!!!!!!!
    
                         If .Shapes(4).OLEFormat.Object.Formula <> c00 Then
                            .Shapes(4).OLEFormat.Object.Formula = c00 'shape(4)!!!!!!!!!!!!!!!
                            .Shapes(4).Top = zoekCell.Top 'shape(4)!!!!!!!!!!!!!!!
                            .Shapes(4).Height = Rng.Height 'shape(4)!!!!!!!!!!!!!!!
                         End If
                      End If
                    End With
                 End If
            End If


 End If
End Sub

 

[snb]

Hoe beter de struktuur van je werkblad, hoe eenvoudiger formules/macro's kunnen zijn.
Blad2 heb ik gefatsoeneerd: geen samengevoegde cellen, geen overbodige kolom A, geen teksten verspreid over verschillende cellen.

In de macromodule van blad2 staat de macro om éénmalig een onbeperkt aantal gedefinieerde gebieden vast te leggen op basis van de gegevens in Blad 2. 3 VBA-regels zijn voldoende.

 

[cow18]

of zo ?