[EXCEL VBA] Opslaan/Afsluiten

[luck7xfx]

Hallo allen,

Ik heb een template gemaakt met daarin 4 verplichte velden. Deze velden vormen de filename in een andere directory dan de originele template. De template zal daarom ook altijd leeg blijven. Als ik de 4 verplichte velden invul en op de knop Opslaan klik, slaat hij een file op in een door mij gekozen directory en sluit de originele template.

Echter wil ik het volgende:

Na het invullen van 4 verplichte velden, op de knop Opslaan/Afsluiten klikken, waardoor mijn originele template weer blanco is en verder gaat met de nieuw aangemaakte file. Ook moet de X knop uit staan en de melding geven "Gebruik de opslaan/afsluiten knop" Momenteel gebruik ik deze code:

code:

Sub File_Opslaan_als()

If ActiveSheet.Range("E2") = Empty Or ActiveSheet.Range("H2") = Empty Or ActiveSheet.Range("K2") = Empty Or ActiveSheet.Range("K3") = Empty Then
MsgBox "xxxx niet ingevuld!"
Exit Sub
End If

Dim Bestandsnaam As String
Dim Directory As String

Bestandsnaam = "Directory" & CStr(Range("K3").Value) & "-" & CStr(Range("K2").Value) & ".xlsm"

If Dir(Directory, vbDirectory) = "" Then
    MkDir (Directory)
    ActiveSheet.Unprotect Password:="WW"
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
    Selection.OnAction = "File_Opslaan"
    ActiveWorkbook.SaveAs Bestandsnaam
    Sheets("Samenstellen").Range("K1").Clear
Else
    If Dir(Bestandsnaam, vbNormal) = "" Then
    ActiveSheet.Unprotect Password:="WW"
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
    Selection.OnAction = "File_Opslaan"
    ActiveWorkbook.SaveAs Bestandsnaam
Else
    MsgBox ("Nummer bestaat al")
    Exit Sub
    End If
End If

Dim a As String
 a = MsgBox("Wilt u de File afluiten", vbYesNo, "Afsluiten")
    If a = vbNo Then
       Exit Sub
    Else
       ActiveWorkbook.Close
    End If
    
End Sub

Sub PRK_Opslaan()

ActiveWorkbook.Save
    MsgBox ("File goed opgeslagen.")

End Sub

Kan iemand mij hiermee helpen?

[ Voor 0% gewijzigd door RobIII op 22-05-2019 22:27 ]

[martyw]

Ik ben geen VBA wizzard, maar ik denk dat je in dit snippet

code:

Dim Bestandsnaam As String
Dim Directory As String

Bestandsnaam = "Directory" & CStr(Range("K3").Value) & "-" & CStr(Range("K2").Value) & ".xlsm"

de bestandsnaam wilt samenstellen. De string variable Directory krijgt geen waarde, daarna wil je de waarde in de Bestandsnaame gebruiken. Ook is iets tussen quotes de letterlijke waarde, niet de inhoud van de variable. Ik denk dat je zoiets bedoelt?

code:

Dim Bestandsnaam As String
Dim Directory As String

Directory = ActiveSheet.Range("E2").value & "/' & ActiveSheet.Range("H2")  & "/"
Bestandsnaam = Directory & CStr(Range("K3").Value) & "-" & CStr(Range("K2").Value) & ".xlsm"

Verder is je code lastig te volgen door de afwezigheid van formattering, iets beter geformatteerd staat er in een volgend snippet

code:

    If Dir(Directory, vbDirectory) = "" Then
        MkDir (Directory)
        ActiveSheet.Unprotect Password:="WW"
        ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
        Selection.OnAction = "File_Opslaan"
        ActiveWorkbook.SaveAs Bestandsnaam
        Sheets("Samenstellen").Range("K1").Clear
    Else
        If Dir(Bestandsnaam, vbNormal) = "" Then
            ActiveSheet.Unprotect Password:="WW"
            ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
            Selection.OnAction = "File_Opslaan"
            ActiveWorkbook.SaveAs Bestandsnaam
        Else
            MsgBox ("Nummer bestaat al")
            Exit Sub
        End If
     End If

Regels 4, 5, 11 en 12 begrijp ik niet, wat is daar de bedoeling van?

[RobIII]

Waar hoort mijn topic?

Programming >> Client Software Algemeen

En als je code post gebruik dan code tags aub.

[ Voor 51% gewijzigd door RobIII op 22-05-2019 22:26 ]

[luck7xfx]

Hoi,

4 en 11 zijn rectangle vormen (de knoppen).

Het is me inmiddels gelukt om mijn eigen vraag te implementeren. Echter krijg ik elke keer na het opslaan en afsluiten van de file een Microsoft excel has stopped working. (Iets met geheugen?)

Verder werkt alles wel. Alleen ik kan het me niet permiteren dat ik deze foutmelding krijg, want als ik andere files open heb staan, worden ze allemaal afgesloten.

martyw schreef op woensdag 22 mei 2019 @ 21:48:
Ik ben geen VBA wizzard, maar ik denk dat je in dit snippet

code:

Dim Bestandsnaam As String
Dim Directory As String

Bestandsnaam = "Directory" & CStr(Range("K3").Value) & "-" & CStr(Range("K2").Value) & ".xlsm"

de bestandsnaam wilt samenstellen. De string variable Directory krijgt geen waarde, daarna wil je de waarde in de Bestandsnaame gebruiken. Ook is iets tussen quotes de letterlijke waarde, niet de inhoud van de variable. Ik denk dat je zoiets bedoelt?

code:

Dim Bestandsnaam As String
Dim Directory As String

Directory = ActiveSheet.Range("E2").value & "/' & ActiveSheet.Range("H2")  & "/"
Bestandsnaam = Directory & CStr(Range("K3").Value) & "-" & CStr(Range("K2").Value) & ".xlsm"

Verder is je code lastig te volgen door de afwezigheid van formattering, iets beter geformatteerd staat er in een volgend snippet

code:

    If Dir(Directory, vbDirectory) = "" Then
        MkDir (Directory)
        ActiveSheet.Unprotect Password:="WW"
        ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
        Selection.OnAction = "File_Opslaan"
        ActiveWorkbook.SaveAs Bestandsnaam
        Sheets("Samenstellen").Range("K1").Clear
    Else
        If Dir(Bestandsnaam, vbNormal) = "" Then
            ActiveSheet.Unprotect Password:="WW"
            ActiveSheet.Shapes.Range(Array("Rounded Rectangle 4")).Select
            Selection.OnAction = "File_Opslaan"
            ActiveWorkbook.SaveAs Bestandsnaam
        Else
            MsgBox ("Nummer bestaat al")
            Exit Sub
        End If
     End If

Regels 4, 5, 11 en 12 begrijp ik niet, wat is daar de bedoeling van?