Macro Opslaan Excel-bestand

[ErikSchrier]

Voor het opslaan van een Excel-sheet gebruik ik onderstaande macro. Echter het bestand kan ik na opslaan niet meer terugvinden. Wat doe ik verkeerd?

Sub Opslaan()
    
    Naam = Cells(6, 5) & " Bijlage 1 Kosteninschatting " & Cells(5, 5) & ".xlsm"
    
    Naam = Application.GetSaveAsFilename(Naam, "Excelbestand met macro's (*.xlsm),*.xlsm")
        
End Sub

 

[leofact]

Met de volgende code lukt het w.s. wel
In de cellen mogen geen tekens staan die niet in bestandsnamen zijn toegestaan.

Sub Opslaan()
dim sNaam as String
sNaam = Cells(6, 5) & " Bijlage 1 Kosteninschatting " & Cells(5, 5) & ".xlsm"
ActiveWorkbook.SaveAs sNaam
end sub

Mvg Leo

 

[ErikSchrier]

Met de aangegeven code lukt het niet. Krijg foutmelding 1004. In mijn Excel sheet zit een 2e active workbook die automatisch in mijn sheet wordt opgeroepen maar niks te maken heeft met mijn worksheet. Dit 2e workbook kan ik ook niet verwijderen. Wat nu te doen?

 

[leofact]

Hoe ziet de gehele snaam string er dan uit?
Kun je die posten?

 

[ErikSchrier]

Bij het doorlopen met F8 kom ik als eerste uit bij

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not Wb.IsAddin And Test_Custom_Properties Then
Controleer_versie
End If
End Sub

daarna bij
' Controleer of de benodigde properties aanwezig zijn
Public Function Test_Custom_Properties() As Boolean
On Error GoTo ErrHandler:

Dim Prop_Teller As Integer
Prop_Teller = 0

For Each p In ActiveWorkbook.CustomDocumentProperties
If Prop_Teller = 2 Then
Exit For
End If
If StrComp(p.Name, "cdpVersienummer", vbTextCompare) = 0 Then
Prop_Teller = Prop_Teller + 1
End If
If StrComp(p.Name, "cdpFileNetID", vbTextCompare) = 0 Then
Prop_Teller = Prop_Teller + 1
End If
Next p
If Prop_Teller = 2 Then
Test_Custom_Properties = True
Else
Test_Custom_Properties = False
End If
Exit Function
ErrHandler:
' error handling code


End Function

en daarna weer bij:

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not Wb.IsAddin And Test_Custom_Properties Then
Controleer_versie
End If
End Sub


en daarna bij:
' Zet een ! achter de versie als het document is gewijzigd
Sub Controleer_versie()
On Error GoTo ErrHandler:

Dim Versie As String

Application.ScreenUpdating = False

If Not ActiveWorkbook.Saved Then
Versie = ActiveWorkbook.CustomDocumentProperties("cdpVersienummer")

' Niets doen als er al een ! staat
If Right(Versie, 1) <> "!" Then
If VersieNummerKlant Then
ActiveWorkbook.CustomDocumentProperties("cdpVersienummerklant") = Versie & "!"
Else
ActiveWorkbook.CustomDocumentProperties("cdpVersienummer") = Versie & "!"
End If
A_Sheet = ActiveSheet.Name
Update_Custom_Properties
Sheets(A_Sheet).Activate
End If
End If

Application.ScreenUpdating = True
Exit Sub
ErrHandler:
' error handling code
End Sub


Hopelijk kan je hier wat mee.

 

[leofact]

Naar ik begrijp komt er van de door jou geposte code geen foutmelding.

De naam waarmee opgeslagen wordt pas bepaald in sub opslaan()

Kun je de naam posten waarmee opgeslagen wordt? Of mooier nog een voorbeeld bestand
Wat wil je trouwens dat de macro's precies doen?


Wanneer het de bedoeling is om één werkblad op te slaan zou de volgende code moeten werken.

Sub Save_ActiveSheet()
Naam = Cells(6, 5) & " Bijlage 1 Kosteninschatting " & Cells(5, 5) & ".xlsm"
     ActiveSheet.Copy
         ActiveWorkbook.SaveAs naam
     ActiveWorkbook.Close False
 End Sub

Uiteraard alleen als het juiste blad actief is