VB Project

[RichieL]

Wanneer ik een worksheet wil exporteren en wil opslaan als *.xlsx krijg ik onderstaande melding:



Kan je dit met een VBA oplossen? Dus optie "ja" in het script meenemen?

 

[edmoor]

Als je een werkboek die VBA code bevat wilt opslaan dan moet dat als .xlsm of .xlsb.

 

[AD1957]

Met exporteren bedoel je waarschijnlijk het opslaan als xlsx bestand van dat werkblad.

Sub Exporteer()
[COLOR="#008000"] 'maak een kopie van het werkblad[/COLOR]
 Sheets("te kopieren").Copy After:=Sheets(Sheets.Count)

 Sheets(Sheets.Count).Select
 [COLOR="#008000"]'verwijder de vba code[/COLOR]
 wsName = Sheets(Sheets.Count).CodeName
 With ThisWorkbook.VBProject.VBComponents(wsName).CodeModule
    .DeleteLines 1, .CountOfLines
 End With


 Dim NieuwFact As Variant
    ActiveSheet.Copy
    NieuwFact = "C:\Users\" & Environ("username") & "\Desktop\" & ActiveSheet.Name & ".xlsx"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs NieuwFact, FileFormat:=51
    ActiveWorkbook.Close
    
 Sheets(Sheets.Count).Delete
End Sub

 

[JEC.]

Displayalerts op False en vervolgens .SaveAs werkt niet?

 

[AD1957]

Bij mij werkt het gewoon.
Misschien wel nog even application.screenupdating=false erbij zetten.

 

[AD1957]

 Sub Exporteer()
 'maak een kopie van het werkblad
 Sheets("te kopieren").Copy After:=Sheets(Sheets.Count)

 Sheets(Sheets.Count).Select
 'verwijder de vba code
 wsName = Sheets(Sheets.Count).CodeName
 With ThisWorkbook.VBProject.VBComponents(wsName).CodeModule
    .DeleteLines 1, .CountOfLines
 End With

Application.ScreenUpdating = False
 Dim NieuwFact As Variant
    ActiveSheet.Copy
    NieuwFact = "C:\Users\" & Environ("username") & "\Desktop\" & ActiveSheet.Name & ".xlsx"
    ActiveWorkbook.SaveAs NieuwFact, FileFormat:=51
    ActiveWorkbook.Close
 
 Application.DisplayAlerts = False
 Sheets(Sheets.Count).Delete
 Application.ScreenUpdating = True
End Sub

 

[JEC.]

Ik heb het niet getest. Ik bedoel, werkt direct SaveAs niet? Ipv eerst leeghalen van de codemodule.

 

[AD1957]

Dan krijg je de melding zoals in #1

 

[HSV]

Voor het "opslaan als .xlsx" is code verwijderen onzin.
Dit is voldoende:

 application.displayalerts = false
 thisworkbook.saveas thisworkbook.path & "\hierjebestandsnaam", 51

 

[JEC.]

Precies, kon al niet geloven dat dit niet zou werken

 

[AD1957]

Als ik de vraag in post #1 goed heb begrepen wil TS slechts 1 Blad opslaan als xlsx.
Of wil hij 1 blad exporteren naar een ander xlsx bestand ?

 

[HSV]

Dan veranderd er weinig.

application.displayalerts = false
[COLOR=#ff0000]blad1.copy[/COLOR]
[COLOR=#ff0000]activeworkbook[/COLOR].saveas thisworkbook.path & "\hierjebestandsnaam", 51

Je code maakt nu ook een nieuw bestand aan met:

 ActiveSheet.Copy

Onderstaande,.....

NieuwFact = "C:\Users\" & Environ("username") & "\Desktop\" & ActiveSheet.Name & ".xlsx"

....kan ook zo.

NieuwFact = Environ("userprofile") & "\Desktop\" & ActiveSheet.Name

 

[AD1957]

Is me helemaal duidelijk, bedankt.

 

[RichieL]

Ik heb bovenstaande nog niet geprobeerd. Dat ga ik zo proberen.
Wat er kort gezegd zou moeten gebeuren:

Ik heb een Workbook, met verschillende sheets
Een sheet bevat wat macro's. De ene keer moet ik macro 1 andere keer macro 2 gebruiken.
Uiteindelijk staat de sheet precies zoals het moet zijn.
Daarna wil ik de alleen deze sheet naar een nieuwe workbook kopieren, zonder formules etc en daarna "opstaan als" (automatisch) zonder de macro in het document welke geen nut meer hebben daarna vandaar: *.xlsx

Onderstaande werkte inderdaad voor mij. Fout die ik maakte is Application.DisplayAlerts = false onder ActiveWorkbook.SaveAs te zetten.

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=path & Filename & Format(Date, "ddmmyyuummss") & ".xlsx", FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close

Dank voor jullie hulp!

 

[AD1957]

Zonder formules ?

Lijkt me toch dat deze er nog instaan.

 

[RichieL]

Ik heb onderstaande de totale code. Ik maak een copy & paste special van de desbetreffende sheet.

Sub test()

Dim path As String

path = "G:\test\"
Filename = "test"

ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveSheet.Buttons.Delete

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=path & Filename & Format(Date, "ddmmyyuummss") & ".xlsx", FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close

End Sub

 

[snb]

Waarom gebruik je de gegeven suggesties niet? (vooiral die van HSV)
Weinig hoffelijk ten opzichte van helpers.

 

[RichieL]

Excuus SNB als je dit zo ziet, maar ik ben heel dankbaar voor de hulp die ieder biedt.
Alleen zit ik nu op mijn werk en bovenstaande is vooral voor privé gebruik. Vooral in de avonden kan ik echt testen en proberen, vandaar dat het misschien zo lijkt, maar nogmaals ik ben erg dankbaar voor alle hulp.

 

[RichieL]

Bedankt Ad1957 & HSV voor jullie hulp. Jullie hulp heeft mij erg geholpen.

De activesheet.copy in combinatie met application.displayalerts = false heeft geholpen.