Controleren of opmaak, kolombreedtes, rijhoogtes zijn gewijzigd.

[jansbl]

Hallo,

Om te controleren of er zich geen wijzigingen op een blad hebben voorgedaan, gebruik ik:

If Intersect(Target, Range (B1:N65536)) Is Nothing Then .......enz., enz......

Is er ook zoiets simpels om te controleren of op een bepaalde sheet de kolombreedtes, rijhoogtes, of opmaak zijn gewijzigd?
De reden is dat ik deze dingen op een aantal andere bladen wil doorvoeren.
Ik "meet" nu domweg de, gebruikte, kolombreedtes en rijhoogtes van het "Verzamelblad" en gebruik deze waardes om de andere bladen aan te passen.
Maar dit gebeurt dan telkens als wijzigingen in data op het "Verzamelblad" moeten worden doorgevoerd naar de andere bladen.
Deze routines worden ook doorgevoerd als er niets (in kolombreedtes en rijhoogtes) is gewijzigd op het verzamelblad, en nemen dus onnodig veel tijd in beslag.

m.vr.gr.,
Jans

 

[Wigi]

Het kopiëren van kolombreedten kan gemakkelijk met Bewerken > Plakken speciaal > Kolombreedten.

In VBA is de tegenhanger de PasteSpecial met als argument xlPasteColumnWidths.

Wigi

 

[jansbl]

Het kopiëren van kolombreedten kan gemakkelijk met Bewerken > Plakken speciaal > Kolombreedten.

In VBA is de tegenhanger de PasteSpecial met als argument xlPasteColumnWidths.

Wigi

Dank je Wim,

Om de dat te kopiëren gebruik ik, in een lus, onegeveer het volgende:

    Worksheets(strName).Unprotect
               Worksheets(strName).Cells.Clear
               Set rng = ActiveSheet.AutoFilter.Range
               rng.Offset(-ExtraRijen, 0).Resize(rng.Rows.Count + ExtraRijen).Copy _
               Destination:=Worksheets(strName).Range("A1")

Hoe zou ik "jouw" xlPasteColumnWidths daaraan toe kunnen voegen?

m.vr.gr.,
Jans

 

[Ginger]

Jansbl, Je zou na het kopieren ook hiervan gebruik kunnen maken...

Sub RijKolomPassend()
    
    With ActiveSheet.UsedRange
        .Columns.EntireColumn.AutoFit
        .Rows.EntireRow.AutoFit
    End With

End Sub

Dan hoef je niet elke kolom of rij langs in een lus.

Groet, Leo

 

[Wigi]

With Sheets(strName)
    
        .Unprotect
        .Cells.Clear
        Set rng = ActiveSheet.AutoFilter.Range
        
        rng.Offset(-ExtraRijen).Resize(rng.Rows.Count + ExtraRijen).Copy .Range("A1")
        
        .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
        Application.CutCopyMode = False
        
    End With

ongeteste code

Wigi

 

[Wigi]

Leo, dat kan werken, maar niet noodzakelijk.

Kolommen kunnen nl. ook breder zijn dan "nodig".

Indien wel, dan is jouw oplossing simpeler

 

[jansbl]

Wim en Leo,

Beide hartelijk dank.
Ik wil dus op alle bladen de breedtes overnemen van het "Verzamelblad", voordat het is gefilterd.
Ik denk dus dat Wim dan gelijk heeft dat sommige kolommen inderdaad breder zijn, gefilterd, dan nodig.

Wim, wat doet

Application.CutCopyMode = False

wat je hebt toegevoegd?

m.vr.gr.,
Jans

 

[Wigi]

Dat zet het "mierenspoor" uit dat je ziet wanneer je een bereik kopieert maar nog niet geplakt hebt.

 

[jansbl]

With Sheets(strName)
    
        .Unprotect
        .Cells.Clear
        Set rng = ActiveSheet.AutoFilter.Range
        
        rng.Offset(-ExtraRijen).Resize(rng.Rows.Count + ExtraRijen).Copy .Range("A1")
        
        .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
        Application.CutCopyMode = False
        
    End With

ongeteste code

Wigi

Dag Wim,

Ik bleef een foutcode krijgen.
Na de regel : "Sheets("Verzamelblad").Range("A1:H1").Copy" tussen te voegen, bleek het uitstekend te werken.

Nu heb ik dus:

With Sheets(strName)
    
    .Unprotect
    .Cells.Clear
    Set rng = ActiveSheet.AutoFilter.Range
    
    rng.Offset(-ExtraRijen).Resize(rng.Rows.Count + ExtraRijen).Copy .Range("A1")
    Sheets("Verzamelblad").Range("A1:H1").Copy
    .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
    
    Application.CutCopyMode = False
        
End With

Weer bedankt :thumb:
m.vr.gr.,
Jans

 

[Wigi]

Sorry, dat was precies iets te gehaast neergepend

De regel met Copy

rng.Offset(-ExtraRijen).Resize(rng.Rows.Count + ExtraRijen).Copy

moet nog een keertje voor de regel met PasteSpecial.

Wigi

 

[jansbl]

Werkt niet in Excel 2000??

Kan het kloppen dat:
.PasteSpecial Paste:=xlPasteColumnWidths
niet werkt in Excel 2000 ?

Jans

 

[Wigi]

Ja, als ik mij goed herinner was dat een bug in Excel 2000. Dit lost het op:

.PasteSpecial Paste:=8

Wigi

 

[jansbl]

Ja, als ik mij goed herinner was dat een bug in Excel 2000. Dit lost het op:

.PasteSpecial Paste:=8

Wigi

Werkt dit dan wel in de later versies, of moet ik een aparte voorwaarde maken voor de Excel 2000 gebruikers?

Jans

 

[Wigi]

Dit blijft werken.

Doe in VBA in het Immediate window maar eens

?xlPasteColumnWidths

en dan Enteren. Je krijgt een 8 als resultaat

Wigi

 

[jansbl]

Dit blijft werken.

Doe in VBA in het Immediate window maar eens

?xlPasteColumnWidths

en dan Enteren. Je krijgt een 8 als resultaat

Wigi

Inderdaad Wim,
Het was me ook al opgevallen toen ik een breakpunt had geplaatst in de code en toen met de muispointer over xlPasteColumnWidths ging.

Bedankt :thumb:,

Jans