• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

macro voor opslaan omzetten naar 2007

Status
Niet open voor verdere reacties.

Ron321

Gebruiker
Lid geworden
15 jul 2005
Berichten
555
Ik gebruik de onderstaande code om een rapport op te slaan vanuit een sjabloon.
Dit werkte prima vanuit een sjabloon in de bestandsvorm XLT naar XLS.
Nu heb ik hem omgezet naar een XLTM en wil ik hem opslaan als XLSM maar dit lukt niet.
Het lukt alleen als ik geen sjabloon gebruik.

Ik krijg de volgende melding:
melding.jpg


Code:
Sub opslaan()
    Application.ScreenUpdating = False
    
    Dim retval
    Dim MyXL As Object
    
    pad = Sheets("voorblad").Range("P1").Value
    If IsFileOpen(pad & "Rapporten.xlsx") Then
        retval = MsgBox("Het bestand Rapporten.xlsx staat open, dit moet afgesloten worden om het rapport op te kunnen slaan." & vbCrLf & "Wilt u deze sluiten?", vbQuestion + vbYesNo)
        If retval = vbYes Then
            Set MyXL = GetObject(pad & "Rapporten.xlsx")
            MyXL.Save
            MyXL.Close
        End If

    End If
''Next
    If Right(pad, 1) <> "" Then pad = pad & ""
    Application.ScreenUpdating = False
        codeA = Sheets("algemeen").Range("H2").Value
        bestand = pad & codeA & ".xlsm"
        bericht = "Bestand wordt opgeslagen als:" & Chr(10) & bestand & Chr(10) & "Is dit correct ?"
        naam_ok = MsgBox(bericht, vbYesNo)
        If naam_ok = vbYes Then
         ActiveWorkbook.SaveAs FileName:=bestand

    Dim VrijeRij, Directory
    Application.ScreenUpdating = False
    Directory = ActiveSheet.Range("P1").Value & ""
    VrijeRij = 2
    Range("R1:Y1").Select
    Selection.Copy
    Workbooks.Open FileName:=Directory & "\Rapporten.xlsx"
    Do Until ActiveSheet.Cells(VrijeRij, 1).Value = ""
        ActiveSheet.Cells(VrijeRij, 1).Select
        VrijeRij = VrijeRij + 1
    Loop
    Application.ScreenUpdating = False
    ActiveSheet.Cells(VrijeRij, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    End If
End Sub
 
Bij het opslaan geef je geen juist FileFormat mee.

Kijk op mijn website voor een artikel omtrent Bestandsformaten (bij Excel > VBA-code)

Wigi
 
Bedankt, met de toevoeging
Code:
, _
                    FileFormat:=52
is het gelukt!
:thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan