Printen vaste kolom + variabele kolom

Status
Niet open voor verdere reacties.
In mijn "echte" file loopt deze code steeds stuk op
Code: 
.Columns(rw).Resize(, 4).Hidden = False

In bijlage...
 

Bijlagen

  • fout.docx
    17,2 KB · Weergaven: 30
En 'rw' komt uit een Match zeker?

Zet er een controle op.

Code: 
if isnumeric(rw) then

of:
Code: 
if not iserror(rw) then
 
eigenlijk stond er een iserror(rw) een paar regels hoger, dus zal het wel iets anders zijn.
Ik gok dat rw resulteert in een kolom die helemaal rechts van je werkblad staat, mogelijks de laatste tot de 3e laatste, zodat er geen 4 kolommen meer resteren, die verborgen kunnen worden.
 
Inderdaad, er is in de "echte" 1 kolom minder.

In de "testfile" staat geen samengevoegde cel in de "echte" is cel B samengevoegd, in bijlage...


Laatste kolom testfile "AD"
Laatste kolom echte file "AC"

Iemand enig idee?

Bedankt!
 

Bijlagen

  • samengevoegde cel.docx
    24,8 KB · Weergaven: 25
zet eventjes volgende voor die regel die de fout veroorzaakt.
Als je daar een fout krijgt, dan heb je zitten knoeien met die IF's daar net voor
Code: 
 MsgBox IIf(IsError(rw), "foutje bedankt", rw)
 
Krijg geen foutmelding, maar probeer verder...

Kan ik ook zeggen dat op het extra aangemaakt werkblad, de samengevoegde cellen moeten "wegvallen".

Dan is dit wel hetzelfde werkblad zoals in de "testfile"
 
bv.
Code: 
.Cells.MergeCells = False
waat is de waarde van rw
 
Ik krijg niks te zien...

Bij de "echte" file in deze bijlage werkt niets, ook geen foutmelding...
 

Bijlagen

  • werkt niet.xlsm
    73,2 KB · Weergaven: 25
ga in de macro staan en loop dan stap per stap door de macro met F8.
Dan zie je hoe de macro werkt en kom je tot de vaststelling, dat er niets gebeurt omdat je datum niet gevonden wordt.
Daarop kan je inspelen door een msgbox (zie onderaan hsv's en mijn macro) toe te voegen.

Laat de boel eventjes een paar dagen rusten, want je ziet van de bomen het bos niet meer.
 

Bijlagen

  • werkt niet.xlsm
    71,1 KB · Weergaven: 31
Klopt...FF stoppen....Pffff…:)

Hij vindt in rij 14 geen datum....Raar….
 
als hij erin staat, dan moet je misschien omzetten naar een long met clng(datum) of zo.
Anders is je datum een string (=tekst) en vind je die ook niet
Ik ben weg !!!
 
Waarom wordt er geen datum gevonden?
In de eerst file (één week) werkt dit allemaal en de tweede file is gewoon een kopie met meerdere weken...

***EDIT***
Ik heb iets gevonden, eerst nog wat spelen...
 
Laatst bewerkt:
er staan op datum lijkende teksten in rij 14, geen getallen, normaal zouden die getoond worden in kolom E
Code: 
Sub AlMijn14s()
    Dim a(4)
    Set dict = CreateObject("Scripting.dictionary")
    With dict
        For Each sh In ThisWorkbook.Sheets
            For Each c In sh.Rows(14).Cells
                If Len(c) Then
                    a(0) = sh.Name
                    a(1) = c.Address
                    a(2) = c.Value
                    a(3) = c.NumberFormat
                    If IsNumeric(c) Then
                    a(4) = CDbl(c)
                    End If
                    .Add .Count, a
                End If
            Next
        Next
    End With

    Set sh = Sheets.Add
    With sh.Range("A1").Resize(dict.Count, UBound(a) + 1)
    .Value = Application.Index(dict.items, 0, 0)
    .EntireColumn.AutoFit
    End With
End Sub
 
Dit had ik gevonden...

Werkende file

dinsdag 5 februari 2019
Code: 
=(DATUM($A$2;1;1)-WEEKDAG(DATUM($A$2;1;1))-ALS(WEEKDAG(DATUM($A$2;1;1))<6;5;-2)+$B$3*7)+1

Niet werkende file

Dinsdag 5 Februari 2019
Code: 
=BEGINLETTERS(TEKST(DATUM($A$2;1;1)-WEEKDAG(DATUM($A$2;1;1))-ALS(WEEKDAG(DATUM($A$2;1;1))<6;5;-2)+$B$3*7+1;"dddd d mmmm jjjj"))

Ik kwam inderdaad het woordje "TEKST" tegen in de tweede code...De code om de beginletters in hoofdletter te zetten...


Ik had de "goede" code in de slechte file gekopieerd en deze werkte, alleen kreeg ik toen een foute layout (ivm met de code
Code: 
.Cells.MergeCells = False
denk ik...)

Is het niet de layout die ik verwachtte...De eerste layout van Cow is de goede...
Ik ga aan de slag...
 
Laatst bewerkt:
voeg anders voor je rij 14 een nieuwe rij in.
Maak daarin je dagen zoals in de 1e formule en werk zonder samengevoegde cellen, dat zijn toch prutsdingen die enkel miserie veroorzaken.
Deze nieuwe rij 14, daar kan je nu je zoekopdracht op los laten.
De oude rij 14, nu rij 15, met die samengevoegde cellen, die verwijst nu naar de datums(=getallen) in rij 14 en daar kan je nu hoofdletters van maken en gebruiken voor je printout.
 
Ik ben mee tot...

De oude rij 14, nu rij 15, met die samengevoegde cellen, die verwijst nu naar de datums(=getallen) in rij 14 en daar kan je nu hoofdletters van maken en gebruiken voor je printout.


***EDIT***

Kan je alleen van tekst de beginletters wijzigen in hoofdletters?
 
Laatst bewerkt:
geen nieuwe rij 14, ik doe het bv. in rij 2.
Enkel aangepast voor E2 en E14
 

Bijlagen

  • werkt niet (2).xlsm
    71,2 KB · Weergaven: 23
Ik ben stap voor stap bezig...Nu heb ik de "goede" (datum/dag zonder TEKST) code in de file gezet...
Maar nu blijven de cellen in rij 14 niet samengevoegd na de printout…
Kunnen deze om te beginnen terug zoals in het begin bij openen van file?
Dit heeft volgens mij ook iets te maken met de "vaste kolom", deze is nog maar drie columns ipv vier...
 
Dit blijft een martelgang.
Gemakshalve kopieren we het ganse werkblad naar een nieuw blad "MijnKopie"
In dat werkblad doen we alle handelingen en printen we af.
Daarna deleten we dat werkblad.
Ik zal wel nog ergens een opmaak of zoiets vergeten hebben, er is al zoveel gevraagd.
Code: 
Sub Cow18()

'ActiveWorkbook.Unprotect ("paswoord")
'ActiveSheet.Unprotect ("paswoord")


    Dim rw, shCopy, shPaste, datum
    Set shCopy = ActiveSheet
    With ActiveSheet
        datum = IIf(IsDate(.Range("A4")), CLng(.Range("A4")), CLng(Date))    'staat er een datum in cel A4, dan neem je die datum
        rw = Application.Match(datum, .Rows(14), 0)                  'zoek datum in huidig werkblad
        If IsError(rw) Then                                          'niet gevonden
            For Each Sh In ThisWorkbook.Worksheets                   'alle werkbladen afzoeken
                rw = Application.Match(datum, Sh.Rows(14), 0)        'anders neem je vandaag
                If Not IsError(rw) Then Set shCopy = Sh: Exit For    'gevonden in een bepaald blad, dan is het die en uit de loop treden
            Next
        End If
    End With

    If Not IsError(rw) Then
        shCopy.Copy After:=shCopy                                    'gewoon het ganse blad kopieren
        ActiveSheet.Name = "MijnKopie"
        With Sheets("MijnKopie")
            .Columns("F:ad").Hidden = True
            .Range("14:15,36:37,60:61").EntireRow.Hidden = True
            .Columns(rw).Resize(, 4).Hidden = False
            .UsedRange.Offset(, 3).SpecialCells(4).Interior.Color = xlNone
            With .PageSetup
                .CenterHeader = Format(datum, "long date")
                .CenterVertically = True
                .CenterHorizontally = True
                .Orientation = xlPortrait
                .PaperSize = xlPaperA4
                .FitToPagesTall = 1
                .FitToPagesWide = 1
                .Zoom = False
                .HeaderMargin = 10
                .TopMargin = 25
                .BottomMargin = 10
            End With
            .Range("A14:AE70").PrintPreview
        End With
        Application.DisplayAlerts = False
        Sheets("MijnKopie").Delete
        Application.DisplayAlerts = True
    Else
        MsgBox "je datum " & Format(datum, "long date") & " bestaat in geen enkele rij 14", vbCritical
    End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan