Subtotalen (en totaal) bold maken

[Veerus]

Goedemorgen, ik probeer al een tijdje om de subtotalen (de hele rij) vetgedrukt te krijgen maar het wil maar niet lukken. Kan iemand mij een richting geven hoe ik dit voor elkaar krijg. (wat ik geprobeerd heb onder Selection.Subtotal is o.a. Rows(1).Font.Bold=True) maar dat werkt dus niet.....?

Sub Workbook_open()
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("calculations").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
    
Dim l As Long
    For l = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
        If Range("A" & l).Value <> Range("A" & l - 1).Value Then
            Rows(l).Insert
        End If
    Next

    Range("A1").Select
    ActiveWindow.SmallScroll Down:=60
    Range("A1:Q100").Select
    ActiveWindow.SmallScroll Down:=-75
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 7, 8, 9, 10 _
        , 11, 12), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=57
    Range("A1:Q100").Select
    Selection.Copy
    Sheets("CI & PL").Select
    Range("A7").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Selection.ColumnWidth = 10.57
    Columns("B:B").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("P:P").EntireColumn.AutoFit
    Columns("Q:Q").EntireColumn.AutoFit
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("B7").Select
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Range("A7").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "CTN nr."
    Range("A1").Select

'kopieer blad naar nieuw leeg bestand
ActiveSheet.Copy

ThisFile = Range("G3").Value
ActiveWorkbook.SaveAs Filename:=ThisFile
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Files (*.xls), *.xls")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If

ThisWorkbook.Close Savechanges:=False
End Sub

 

[Hoornvan]

Veerus,

Dit heb ik op een leeg blad geprobeerd en werkte.

Sub Bold()
  Range("A5").Font.Bold = True
End Sub

 

[DCWDPT]

Kleine aanpassing

Veerus,

De oplossing van Hoornvan werkt voor (in dit voorbeeld) alleen cel A5. Een kleine aanpassing en het werkt voor de hele rij:

Sub Bold()
  Range("A5").EntireRow.Font.Bold = True
End Sub

:thumb:

 

[Veerus]

Ja idd dit werkt alleen voor deze "specifieke rij" maar in mijn file zijn er soms wel 10 subtotalen (variabel) en die wil ik dus vet gedrukt maken...

 

[DCWDPT]

dit dan?

Het je het ook op deze manier geprobeerd? Ik kan het niet voor je testen omdat er geen voorbeeldbestand is.

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 7, 8, 9, 10 _
        , 11, 12), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
With Selection.Subtotal
    .EntireRow.Font.Bold = True
End With

:thumb:

 

[Veerus]

Ja zoiets had ik ook al geprobeerd, antwoord is "Het argument is niet optioneel"

Ik heb de file er maar ff bijgedaan, werkt wat makkelijker denk ik. Ik hoop dat iemand mij hiermee kan helpen.

Oh om de marco te starten druk CTRL+P


Bekijk bijlage Commercial Invoice and Packing List.xls

 

[DCWDPT]

Ik heb er nu dit van gemaakt:

With Subtotal
        Selection.EntireRow.Font.Bold = True
    End With

En dan wordt alles vet. Da's geloof ik niet de bedoeling, maar misschien kun je er zelf wat verder mee experimenteren. Ik heb nu even geen tijd meer.

:thumb:

 

[snb]

Sub tst()
  With Sheets(1).Range("A1")
    .CurrentRegion.Subtotal 1, xlSum, Array(5, 7, 8, 9, 10, 11, 12), True, False, True
    With .CurrentRegion
     .Rows(.Rows.Count).Font.Bold = True
    End With
  End With
End Sub

 

[Veerus]

De optie van DCWDPT werkt idd (maar dan wordt alles vet gedrukt), ik krijg die van snb niet werkend. Aarrggh ik wordt gek hier. Zo moeilijk moet dit toch niet zijn....zucht

 

[Wigi]

ik krijg die van snb niet werkend.

Snb bedoelde wellicht:

Sub tst()
    With Sheets(1).Range("A1")
        .CurrentRegion.Subtotal 1, -4157, Array(5, 7, 8, 9, 10, 11, 12), True, False, True
        .CurrentRegion.Columns(1).SpecialCells(2).Offset(, 1).SpecialCells(4).EntireRow.Font.Bold = True
    End With
End Sub

Wigi

 

[snb]

eerder dit (getest in het door de vragensteller geplaatste bestand)

Sub tst()
  With Sheets("original").Range("A1")
    .CurrentRegion.Subtotal 1, xlSum, Array(5, 7, 8, 9, 10, 11, 12), True, False, True
    .CurrentRegion.SpecialCells(-4123).Font.Bold = True
  End With
End Sub

 

[Wigi]

Bij de oplossing van Snb is er wel de kwalificatie dat de oorspronkelijke tabel zonder subtotalen geen formules mag bevatten.

Wigi

 

[Cobbe]

Laat deze macro lopen vóór het opslaan.

Sub vetdruk()
For Each c In Range("B8:B" & Range("B65000").End(xlUp).Row)
If Left(c, 6) = "Totaal" Then
Rows(c.Row).EntireRow.Font.Bold = True
End If
Next
End Sub

Eenvoudig en toch werkt het.

Cobbe

 

[Wigi]

Eenvoudig en toch werkt het.

Klopt, maar wellicht niet efficiënt als het om veel rijen aan gegevens gaat.

 

[Cobbe]

Klopt, maar wellicht niet efficiënt als het om veel rijen aan gegevens gaat.

Klopt misschien maar het gaat hier om max. 50 rijen.....

in mijn file zijn er soms wel 10 subtotalen (variabel) en die wil ik dus vet gedrukt maken...

Gr. Cobbe