Code verwijderen en opslaan als .xlsx

[Morsyd]

Hallo,

Ik heb een bestand "voorbeeld.xlsm". Na een bepaalde codering zou dit moeten opgeslaan worden als "voorbeeld_verzenden.xlsx".
Alle VBA-code moet dus verwijderd worden, op het einde van mijn code (zodat de mensen naar wie ik deze file doorstuur de code niet meer kunnen gebruiken/misbruiken).

Op het einde van mijn codering heb ik momenteel dit

naam = ThisWorkbook.Name                                                            'hier dus "voorbeeld.xlsm"
locatie = ThisWorkbook.Path                                                         'bv. "C:\Users\Morsyd\MyDocuments"
bestandsnaam = Mid(naam, 1, (Len(naam) - 5))                                        'dit moet ik doen om de .xlsm af te knippen van mijn Naam
filesavename = locatie & "\" & bestandsnaam & "_verzenden.xlsx"                     'in C:\Users\Morsyd\MyDocuments zou dus een bestand "voorbeeld_verzenden.xlsx" moeten komen

ActiveWorkbook.SaveAs filesavename

Op het einde loopt het dus mis, gezien je een xlsm mét code niet zomaar kan opslaan als xlsx (ik wens liefst geen displayalerts te krijgen die me zeggen dat ik het moet opslaan als...)

Kan iemand me helpen?

alvast bedankt!

 

[ReneDirks]

Was even werk, maar dan heb je ook wat...

Sub SaveWithoutXLM()
    Dim fPath As String
    Dim fName As String
    Dim iPos As Integer
    Dim wbNew As New Workbook
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim i As Integer
    
    Set wb = ThisWorkbook
    fPath = wb.Path
    fName = wb.Name
    fName = StrReverse(fName)
    iPos = InStr(fName, ".")
    If iPos > 0 Then fName = Mid(fName, iPos + 1)
    fName = StrReverse(fName) & ".xlsx"
    
    'add a new workbook
    Excel.Application.SheetsInNewWorkbook = 1
    Set wbNew = Excel.Application.Workbooks.Add
    'just a name to prevent conflicts
    wbNew.Sheets(1).Name = "QQ_QQ"
    
    'copy all sheets to the new workbook
    For Each ws In wb.Sheets
        ws.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
    Next
    'remove the first sheet
    Dim bSetting As Boolean
    bSetting = Application.DisplayAlerts
    Application.DisplayAlerts = False
    wbNew.Worksheets(1).Delete
    Application.DisplayAlerts = bSetting
    wbNew.SaveAs fPath & "\a" & fName, xlOpenXMLWorkbook
End Sub

 

[Morsyd]

Super! Bedankt!
Ik had ondertussen ook al gevonden dat je dit enkel kan doen door de inhoud van je bestand te kopiëren naar een nieuw bestand...
Maar dit helpt me natuurlijk meer op weg! Bedankt!

 

[snb]

Ik dacht meer aan:

Sub M_snb()
  Application.DisplayAlerts = False

  c00 = ThisWorkbook.FullName
  ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & CreateObject("scripting.filesystemobject").GetBaseName(c00) & ".xlsx", 51
  ThisWorkbook.SaveAs c00, 52
End Sub