Opgelost Kleur werkblad uit zetten bij het maken van een PDF

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.
AHulpje, heb het ergens anders neergezet :-) in het nieuw gemaakte file en werkt nu, maar helaas haalt hij ook de lijnen weg en die wil ik graag houden voor het overzicht.
 
Zonder je code te zien is het lastig te beoordelen waar het fout gaat. Plaats je code of een uitgekleed voorbeeld eens hier.
 
ok
het maken van een PDF gaat in 3 stappen
1e is een nieuw excel file maken met de juiste data
2e is checken of file bestaat
3e is een pdf maken van het nieuwe excel file
Gaat in dit geval om het 1e. een nieuw excel file maken met de juiste data en opmaak.

Code hieronder
Code: 
Private Sub Excel_File_Maken()                              ' revisie [24-01-2025]  maakt een extra WerkBlad aan
  Dim c01 As String, MJOBJaar As Integer, i As Integer
  Application.DisplayAlerts = False
  Worksheets("Blad1").Activate         ' activeert wb DBase cel A1

  With Worksheets("Blad1")
    If PrintType = "PDFIndividueel" Then           ' But2 één bepaalde pagina printen
      If PDFKleurOfCheckBox = True Then MsgBox ("PDF = 0"): .Range("G1") = 0        ' doorgeven PDFKleurCheckBox voor nwe file
      If PDFKleurOnCheckBox = True Then MsgBox ("PDF = 1"): .Range("G1") = 1        ' doorgeven PDFKleurCheckBox voor nwe file
      ActiveWorkbook.Worksheets("Blad1").Range("A1").Select                 ' zet active cel op A1
      If Pagina = 1 Then .Range("A1:H42").Select: SelRange = "A1:H42"       ' SelRange = selectie
      If Pagina = 2 Then .Range("A43:H83").Select: SelRange = "A43:H83"     ' SelRange = selectie
      If Pagina = 3 Then .Range("A84:H94").Select: SelRange = "A84:H94"     ' SelRange = selectie
  
     If PrintPDFType = 2 Then
       If Pagina = 1 Then c01 = ActiveWorkbook.Worksheets("Control").Range("D6") & ActiveWorkbook.Worksheets("Control").Range("D10") & "PDFPag1" & ".xls" ' Path en Naam  + Pag1 + extensie
       If Pagina = 2 Then c01 = ActiveWorkbook.Worksheets("Control").Range("D6") & ActiveWorkbook.Worksheets("Control").Range("D10") & "PDFPag2" & ".xls" ' Path en Naam  + Pag1 + extensie
       If Pagina = 3 Then c01 = ActiveWorkbook.Worksheets("Control").Range("D6") & ActiveWorkbook.Worksheets("Control").Range("D10") & "PDFPag3" & ".xls" ' Path en Naam  + Pag1 + extensie
     End If
    End If
    If PrintType = "PDFAll" Then                    ' But3 Alle (3) pagina's printen
      If PDFKleurOfCheckBox = True Then MsgBox ("PDF = 0"): .Range("G1") = 0        ' doorgeven PDFKleurCheckBox voor nwe file
      If PDFKleurOnCheckBox = True Then MsgBox ("PDF = 1"): .Range("G1") = 1        ' doorgeven PDFKleurCheckBox voor nwe file
      .Range("A1:H94").Select: SelRange = "A1:H94"       ' SelRange = selectie
      c01 = ActiveWorkbook.Worksheets("Control").Range("D6") & ActiveWorkbook.Worksheets("Control").Range("D10") & "PDFAll" & ".xls" ' Path en Naam  + Pag1 + extensie
    End If
    
    .Range(SelRange).Copy
  End With
    With ActiveWorkbook.Sheets.Add                            ' maakt een nieuw wb aan
    If PrintType = "PDFIndividueel" Then                       ' But2 één bepaalde pagina printen
      If PDFKleurOfCheckBox = True Then                     ' zwart-wit
        .Range("A1").PasteSpecial Paste:=xlPasteValues      ' https://www.thespreadsheetguru.com/the-code-vault/best-way-to-copy-pastespecial-values-only-with-vba
        .Range("A1").PasteSpecial xlPasteFormats            ' https://wellsr.com/vba/2018/excel/vba-pastespecial-values-formats-formulas-and-more/
      End If
      If PDFKleurOnCheckBox = True Then
        .Range("A1").PasteSpecial Paste:=xlPasteAll         ' kleur
      End If
    End If
    If PrintType = "PDFAll" Then                            ' But2 Alle (3) pagina's printen
      If PDFKleurOfCheckBox = True Then                     ' zwart-wit
        .Range("A1").PasteSpecial Paste:=xlPasteValues      ' https://www.thespreadsheetguru.com/the-code-vault/best-way-to-copy-pastespecial-values-only-with-vba
        .Range("A1").PasteSpecial xlPasteFormats            ' https://wellsr.com/vba/2018/excel/vba-pastespecial-values-formats-formulas-and-more/
      End If
      If PDFKleurOnCheckBox = True Then
        .Range("A1").PasteSpecial Paste:=xlPasteAll         ' kleur
      End If
    End If

     Application.CutCopyMode = False                        ' maakt klembord leeg
 '   .Columns.AutoFit                                       ' past de kolommen aan, aan de nodige breedte
    .Columns("A").ColumnWidth = 4                           ' kolom A in nwe file
    .Columns("B").ColumnWidth = 12                          ' kolom B in nwe file
    .Columns("C").ColumnWidth = 20                          ' kolom C in nwe file
    .Columns("D").ColumnWidth = 10                          ' kolom D in nwe file
    .Columns("E").ColumnWidth = 12.67                       ' kolom E in nwe file
    .Columns("F").ColumnWidth = 22.22                       ' kolom F in nwe file
    .Columns("G").ColumnWidth = 6.11                        ' kolom G in nwe file
    .Columns("H").ColumnWidth = 52.89                       ' kolom H in nwe file
    .Copy                                                                   ' maakt een kopie van dit nieuwe wb
    With ActiveWorkbook                                                     ' met nieuwe wb
      With ActiveSheet.PageSetup                                            ' zet de juiste marges neer voor nieuwe file
        .Orientation = xlLandscape                                          ' https://www.ozgrid.com/forum/forum/help-forums/excel-general/139429-pagesetup-and-papersize-macro
        .PaperSize = xlPaperA4
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.2)
        .BottomMargin = Application.InchesToPoints(0.2)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
      End With
      .SaveCopyAs c01                                                       ' met nieuwe wb, slaat op als file
      .Close                                                                ' met nieuwe wb, sluit dit nieuw file, belangrijk omdat onder Check Excel Bestaat
    End With                                                                ' een Path moet worden ingelezen van wb Control.Range("D6")!
    .Delete                                                                 ' met nieuwe wb, deze verwijderen
  End With
End Sub

Dus resultaat zou moeten zijn dat data overgezet wordt plus de belijning en GEEN kleur.
 
Waarom zo ingewikkeld:
Code: 
Sub KopieerBladZonderKleur()
    Sheets("Blad1").Copy
    With Cells
        .Interior.Pattern = xlNone
        .Font.ColorIndex = xlAutomatic
    End With
End Sub
Kolombreedtes, rijhoogtes en celranden worden netjes mee gekopieerd, alleen de kleuren worden gewist.
 
waarom zo ingewikkeld, wel omdat er meerdere keuzes zijn en klopt niet dat laatste, rijhoogtes kan net verschillend zijn waardoor, als je meerdere pagina's maakt het hoofd v/d pagina verkeerd staat.
Helaas dat is de praktijk.
Dus pak het maar resoluut aan om een goede resultaat te hebben.
En war ik al eerder zei, met jouw code zijn er ook geen regels en kantlijnen meer.
 
Ben eruit :-)
Moest het alleen op de goede plek zien te krijgen.
Heb dus jouw code er tussen geplakt en het werkt en ook met lijnen.
Dus heb voor 2 keuzes nu ook zwart-wit.
Moet er nog 2 doen, met weer andere opties maar uiteindelijk gelukt :)
Dus wat hebben we weer geleerd:
- dat PageSetup.BlackAndWhite niet werkt in excel
- hoe wel Zwart en Wit te verkrijgen
Many Thanks AHulpje het was de oplossing
Hou hem nog even op niet opgelost totdat ik de ander 2 ook gedaan hebt.
 
Zit nog wel met een vraagje waar ik naar op zoek ben.

Wil als extra op het file 2 knoppen maken, welke bepaalde mappen opent.
Waarom, wel is makkelijk om te checken of de files ook aangemaakt worden en evt. te kopieeren voor derden.
Weet ff niet meer met wel opdrachten dat moet.
Dus ben zoekende :cool:
 
Probeer het hier eens mee:
Code: 
Function BestaatBestand(filenaam) As Boolean
    If Dir(filenaam) <> "" Then BestaatBestand = True
End Function

Sub test()
    filenaam = ThisWorkbook.FullName
    If BestaatBestand(filenaam) Then
        MsgBox "Bestand " & filenaam & " bestaat."
    Else
        MsgBox "Bestand " & filenaam & " niet gevonden."
    End If
    filenaam = "DitBestandBestaatVastNiet"
    If BestaatBestand(filenaam) Then
        MsgBox "Bestand " & filenaam & " bestaat."
    Else
        MsgBox "Bestand " & filenaam & " niet gevonden."
    End If
End Sub
 
Goedemorgen AHulpje,

Dit werkt, maar is niet wat ik bedoelde.
Maak met m'n file 2 files aan.
- een excel file
- en een PDF file.
Beidde staan in een aparte map.
Bedoeling is als ik hen een actuele update geef zodat de files worden vernieuwd, ik vervolgens op één van deze 2 knoppen kan klikken om te zien of deze is aangemaakt en evt. te kopiëren voor een ander.
Dus de desbetreffende map moet zichtbaar worden geopend. meer niet.
Met een vba opdracht. Het Path staat al in het file.
Kan er niet op komen welke opdracht dat is om een map te openen.
 
Laatst bewerkt:
Dat kan bijvoorbeeld zo:
Code: 
Pad = "C:\Temp"
Shell "C:\WINDOWS\explorer.exe " & Pad, vbNormalFocus
 
Laatst bewerkt:
Hee toppie Edmoor, werkt perfect kon er alleen niet opkomen :-(

Dit had ik ooit weleens gehad, vroeger met QuickBasic gewerkt.
Morgen file nog eens grondig testen, maar eers lekker ontspanning, even de stad in :)
Thanks allemaal weer
 
Hoi Edmoor,
Weer heel gezellig geweest vanmiddag,
Rest mij nog 1 vraagje: kan je het formaat van het (ja hoe zeg je dat) het geopende scherm op je eigen ingestelde grootte openen?
Zodat ik niet gelijk het hele scherm vol heb met de map.

Ter advies voor goede muziek.
Radio ROL https://www.rolradio.eu/
Jaren 60-70 en 80 voor goede muziek met jukebox en chat.
met zondagavond even een uurtje op de chat van ROL.
Ben er altijd tussen 21.30 en 23.00
 
Dat kan bijvoorbeeld met iets als dit in de ThisWorkbook sectie:
Code: 
Private Sub Workbook_Open()
    With ActiveWindow
        .WindowState = xlNormal
        .Height = 500
        .Width = 1000
    End With
End Sub

Lees ook dit eens:
stackoverflow.com

Change Excel Windows sizes to half the screen

I have 4 Excel Windows: Microsoft Visual Basic for Applications - PERSONAL.XLSB [break] Workbook1 Workbook2 Workbook3 I want to Change the sizes of my windows in that way: VBA will be: Height = ...
stackoverflow.com stackoverflow.com
 
Heb het over de geopende Excel map of PDF map
Dus niet over het geopende Excel file
Zoiets?
Code: 
Dim Path As String
  Path = ActiveWorkbook.Worksheets("Control").Range("D6")
  Shell "C:\WINDOWS\explorer.exe """ & Path & "", vbNormalFocus
  Shell.Height = 500
  Shell.Width = 1000
 
Laatst bewerkt:
Ah, dan begreep ik het verkeerd.
Maak een map op de gewenste grootte en sluit dan de map.
Als je de map weer opent is deze in dat formaat.
 
Correctie:
Code: 
Private Sub MapExcelBut_Click()
  Dim Path As String
  Path = ActiveWorkbook.Worksheets("Control").Range("D6")
 
  Shell "C:\WINDOWS\explorer.exe """ & Path & "", vbNormalFocus
  With ActiveWindow
    .WindowState = xlNormal
    .Shell.Height = 500
    .Shell.Width = 1000
  End With
End Sub
werrkt helaas niet
 
ok, map gaat inderdaad op de laatste grootte open, maar geeft direct de foutmelding:
Fout 438 tijdens uitvoering
Deze eigenschap of methode wordt niet ondersteunt door dit object

:-(

dus is niet direct instelbaar
 
Je bedoelt dus de map die je vanuit VBA opent.
Dat maak het ineens duidelijker.
Wat je schrijft gaat inderdaad niet werken.
De grootte van een Shell venster kan je niet op een gewenst formaat instellen.

Lees hier de verschillende opties:
learn.microsoft.com

Shell function (Visual Basic for Applications)

Office VBA reference topic
learn.microsoft.com
 
Ben bezig met dit als test, maar helaas
Code: 
 ' Shell "C:\WINDOWS\explorer.exe """ & Path & "", vbNormalFocus
  Shell Path
 ' With ActiveWindow
   With Shell
 '   .WindowState = xlNormal
 '   .Shell.Height = 500
 '   .Shell.Width = 1000
 '   .Top = 100
 '   .Left = 10
    .Height = 10   'Application.UsableHeight
    .Width = 10   'Application.UsableWidth
  End With

Hoe heet zo'n venster met die map?
 
Het Application window is je Excel scherm.
Zie ook #38.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan