load macro

[flats]

ja

ja in feite wel maar ze moeten het eender waar en op wat kunnen opslaan, zelfs al was het op een usb was die van hand tot hand, van bureel naar bureel gaat, of zelfs ergens op een server staat, maakt niet uit, als het maar nooit veranderd van naam. Ik kan immers niet weten op wat of waar ze het bestandje gaan zetten en laten gebruiken.

 

[edmoor]

Vandaar mijn voorbeeld om alleen het pad op te vragen waar het moet worden opgeslagen. Die dialoog laat inderdaad alleen folders zien en geen bestanden. Maar dat lijkt me dan ook precies de bedoeling.

Tevens kan die eenvoudig worden uitgebreid met de controles waar je om vroeg:

Sub Opslaan()
     With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show <> 0 Then
            On Local Error GoTo Fout
            Application.DisplayAlerts = False
            ThisWorkbook.SaveAs (.SelectedItems(1) & "\" & ThisWorkbook.Name)
            Application.DisplayAlerts = True
            ThisWorkbook.Close [COLOR="#008000"]'Of Application.Quit[/COLOR]
        Else
            Exit Sub
        End If
    End With

Fout:
    MsgBox "Fout " & Err.Number & ":" & vbCrLf & Err.Description, vbCritical, "Fout bij opslaan"
End Sub

 

[flats]

gebruiker

Zal zeker uittesten maar mijn gebruiker(s) moeten de bestandsnaam kunnen zien om te vermijden dat hun machinelijst door onoplettendheid op meerdere plaatsen komt te staan.
Ik ga alles nog eens rustig bekijken

 

[edmoor]

Er kan ook een melding bij die laat zien als een bestand al bestaat.
Wat ik in #42 plaatste overschrijft een bestand megt dezelfde naam zonder daar melding van te maken.

 

[flats]

huidige toestand

Momenteel heb ik deze werkende macro (heeft inmiddels een andere naam)
Een leuke aanvulling zou zijn om de melding te laten verschijnen dat het opslaan gelukt is, dat lukt mij nog niet om dat in de macro op de juiste plaats te krijgen.

Sub VraagBestand()
ActiveSheet.Unprotect
Range("b3:f101").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("b3").Select
ActiveSheet.Protect
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Save a file"
.InitialFileName = "machinelijst_draaien"
If .Show = -1 Then
bestand = Split(.SelectedItems(1), "")(UBound(Split(.SelectedItems(1), "")))
If Split(bestand, ".")(0) <> "machinelijst_draaien" Then
MsgBox "OPGELET - Het bestand kan enkel opgeslagen worden met bestandnaam 'machinelijst_draaien'"
End If
ActiveWorkbook.save
End If
'MsgBox "machinelijst_draaien is met succes opgeslagen"
End With
'MsgBox "machinelijst_draaien is met succes opgeslagen"
'ActiveWorkbook.Close

End Sub

 

[edmoor]

Dat hoeft uiteraard alleen maar direct na het opslaan
Probeer dit eens:

Sub VraagBestand()
    ActiveSheet.Unprotect
    Range("b3:f101").Select
    Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Range("b3").Select
    ActiveSheet.Protect
    
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Bestand opslaan"
        .InitialFileName = "machinelijst_draaien"
        If .Show = -1 Then
            bestand = Split(.SelectedItems(1), "")(UBound(Split(.SelectedItems(1), "")))
            If Split(bestand, ".")(0) <> "machinelijst_draaien" Then
                MsgBox "OPGELET - Het bestand kan enkel opgeslagen worden met bestandnaam 'machinelijst_draaien'"
                Exit Sub
            End If
            On Local Error GoTo Fout
            ActiveWorkbook.Save
            MsgBox "machinelijst_draaien is met succes opgeslagen"
            ActiveWorkbook.Close
        End If
    End With

Fout:
    MsgBox "Fout " & Err.Number & ":" & vbCrLf & Err.Description, vbCritical, "Fout bij opslaan"
End Sub

 

[flats]

bijlage

Er is iets met de volgorde in die laatste macro, hier in bijlage het bestandje, misschien is dat wat duidelijker heBekijk bijlage machinelijst_draaien(2).xlsm

 

[flats]

Deze werkt naar wens:
Sub VraagBestand()

ActiveSheet.Unprotect
Range("b3:f101").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("b3").Select
ActiveSheet.Protect
restart_here:
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Save a file"
.InitialFileName = "machinelijst_draaien"
If .Show = -1 Then
bestand = Split(.SelectedItems(1), "")(UBound(Split(.SelectedItems(1), "")))
If Split(bestand, ".")(0) <> "machinelijst_draaien" Then
MsgBox "OPGELET - Het bestand kan enkel opgeslagen worden met bestandnaam 'machinelijst_draaien'"
GoTo restart_here
Else
ActiveWorkbook.Save
MsgBox "machinelijst_draaien is met succes opgeslagen"
End If
End If
End With
'ActiveWorkbook.Close

End Sub

 

[OctaFish]

@flats: je bent nu al een aantal jaar bekend met HelpMij, en hebt ongetwijfeld al vele berichten gezien met voorbeeld codes die keurig zijn opgemaakt. Zelfs in je eigen draadje staat het vol met code die netjes in de tags staan. Alleen die van jou willen maar niet met de CODE tag opgemaakt worden. Misschien moet je dat toch eens doen, al was het maar omdat je dat zélf ook netter vindt staan .

 

[flats]

code

Oke, ik zal er in het vervolg op letten, vandaar dat de voorbeelden zo netjes in een kaderke staan dus

sub kaderke()