• 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.

"Oplsaan als" en als .xlsm

Status
Niet open voor verdere reacties.
Nee, D6 heb ik gelaten voor wat het was.
Maakt ook niets uit voor het opslaan lijkt me, of er moeten tekens in staan die niet kunnen, maar daar krijg je dan wel weer een melding van.
 
Test deze eens
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim varWorkbookName As String, FileFormatValue As Integer
    On Error GoTo Quit
    Cancel = True
    Set shinfo = Sheets("Info").Range("D6")
    Set shmain = Sheets("Main").Range("L20")
    Application.EnableEvents = False
    If SaveAsUI = False Then
        If WorksheetFunction.Or(shinfo = "", shmain = "") Then
            MsgBox "Onderstaande cellen zijn waarschijnlijk niet gevuld  " _
            & vbCrLf & "Blad ""Info"" " & shinfo.Address _
            & vbCrLf & "Blad ""Main"" " & shmain.Address, vbExclamation, "LET OP !"
            Exit Sub
        Else
            varWorkbookName = Application.GetSaveAsFilename( _
                FileFilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm", _
                Title:="Kies je map en pas de bestandsnaam indien nodig aan!")
        End If
        If varWorkbookName <> "False" Then
            Select Case LCase(Right(varWorkbookName, Len(varWorkbookName) - InStrRev(varWorkbookName, ".", , 1)))
                Case "xlsm": FileFormatValue = 52
            End Select
            ActiveWorkbook.SaveAs varWorkbookName
            MsgBox "Klaar! Opgeslagen als: " & varWorkbookName
        End If
    End If
Quit:
    If Err.Number > 0 Then
        If Err.Number <> 1004 Then
            MsgBox "Fout: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & _
            "Titel", vbCritical
        End If
    End If
    Application.EnableEvents = True
End Sub
 
nog eens vanalles getest, de code van jou Rudi (en bedankt dat ook jij er even wou naar kijken), gewoon op desktop proberen weg schrijven... voorlopig niks dat het bij mij doet. ik vrees dat het toch aan die Excel 2010 zal liggen hoor aangezien dat het bij jullie wel werkt.
een code die het wel doet, maar mij niet die suggestie geeft waar jullie al zo hard aan werkten (en dus ook niet de mogelijkheid een folder te kiezen) en gewoon de data uit die 2 cellen haalt is deze:

Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Year As Long
Dim Month As Long
Dim Day As Long
Year = Worksheets("Main").Range("N20").Value
Month = Worksheets("Main").Range("N21").Value
Day = Worksheets("Main").Range("N22").Value

Application.EnableEvents = False

If SaveAsUI = False Then
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Design Summary" & " - " & Sheets("Info").[D6].Value & " - " & Year & "w" & Month & "d" & Day & ".xlsm"
MsgBox "Done! Saved as: " & ThisWorkbook.Path & "\" & ThisWorkbook.Name
End If

Cancel = True
Application.EnableEvents = True

End Sub

@Rudi, bij jouw code zelfde probleemals bij die van Harry, alles lijkt normaal te lopen (dwz tot en met het save scherm en de mogelijkheid op de save knop te drukken) tot ik naar de folder ga die ik geselecteerd heb en daar vind ik geen bestand terug

in bijlage nog even het bestand dat het wel doet met de code zoals hierboven

Bekijk bijlage Design Summary - HP000_00000 - 12w19d5.xlsm
 
Goede avond heren,
Het is dus inderdaad een Excel 2010 probleem hé! Harry, jouw code werkt perfect… in de 2007. Ik had hier nog een 2007 student version liggen die ik nog niet geïnstalleerd had, daarjuist toch gedaan en jouw bestand uitgeprobeerd. Niet dat ik twijfelde aan je expertise hoor. Dus twee computers naast elkaar met exact hetzelfde bestand en dezelfde wijzigingen. De 2007 doet perfect waar Harry’s code voor geschreven is en de 2010 gaat dus de mist in.

Rest me enkel nog jullie nogmaals heel erg te bedanken voor jullie inzet en hulp bij mijn probleem en respect te tonen voor jullie kunnen. En de vraag opgelost te zetten want dat is hij eigenlijk wel.

Niet dat het veel aarde aan de dijk zal brengen vrees ik maar ik ga toch eens proberen dit probleem bij Microsoft aan te kaarten.

Bedankt mannen.
 
Laatst bewerkt:
Hallo Tonissteiner.

Ik kom op diverse fora de '.execute' op een andere plaats tegen in de code.
Als ik de 'execute' interpreteer, komt het voor de '.show', maar werkt dan niet direct bij het opslaan.
Dus vandaar dat ik het na de '.show' heb gezet, en slaat het bestand direct op met de juiste bestandsnaam (bovenaan tezien).
Sommige Vba’ers schrijven het voor de '.show' methode.
Dus:
.execute
.show

Test het eens in 2010 als je wilt.
 
Laatst bewerkt:
Dag Harry,

meteen uitgetest en zelfde resultaat hoor... verdorie jammer toch hé. Ook als ik bijvoorbeeld in het save as scherm de bestandsnaam nog aanpas wordt het bestand toch niet opgeslagen
 
Jammer,

Ik was wat aan het Googlen omtrent 2007 vs. 2010.
Wel vreemd, de code loopt nergens vast, maar werkt niet.
Zodra ik wat weet verneem je het van me.
 
Heeft het misschien iets te maken met machtigingen ?
Heb je administrator-rechten ?
 
Goede morgen Rudi,

ja die heb ik.
misschien zou het handig zijn dat iemand anders met een Excel 2010 Harry's bestandje even kon uitproberen
 
Code: 
misschien zou het handig zijn dat iemand anders met een Excel 2010 Harry's bestandje even kon uitproberen
Zelf heb ik geen excel 2010 en kan je met VBA ook onvoldoende helpen.

Je hebt je vraag nu op opgelost staan.

Misschien dat medeforumleden hierdoor je vraag niet meer gaan bekijken.
 
Laatst bewerkt:
Hallo Oeldere,

ja inderdaad, je hebt gelijk. eigenlijk was ik gewoon benieuwd of het aan mijn 2010 (de installatie ervan ofzo) zou liggen of een algemene fout in de 2010.
dus eigenlijk is de vraag wel opgelost want de code werkt en niemand kan "de" eigenlijke een fout vinden (als het al een fout zou zijn) waardoor het in 2010 niet werkt.
dus ja, zet ik de vraag onopgelost of toch opgelost? of open ik een nieuw topic met de vraag "wie wil een bestand met code "save as" eens uitproberen in Excel 2010?"
 
Dag heren,

even ter info. ik had via de site answers van Microsoft dit probleem daar ook even geplaatst en kreeg daar van Jan reeds een reactie. hij stelde voor om de code in de module aan te passen als volgt:

Code: 
Option Explicit
 Public shinfo As Range, shmain As Range
 Sub HSV()
 On Error Resume Next
 Application.DisplayAlerts = False
   
With Application.FileDialog(msoFileDialogSaveAs)
     .InitialFileName = "Design Summary - " & shinfo & " - " & Format(shmain, "00w00d0") & ".xlsm"
     .Title = "Opslaan als"
     .FilterIndex = 2
     If .Show = -1 Then
         .Execute
     End If
    End With
 End Sub

Jan dacht dat de code zo wellicht wel zou werken.

Echter jammer genoeg gaf dit nog steeds hetzelfde resultaat bij mij

dit even ter info voor jullie

geniet alvast nog van jullie weekend
 
WOEHOEW, heb hem werkende gekregen.

met volgende code: in ThisWorkbook

Code: 
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Set shinfo = Sheets("Info").Range("D6")
 Set shmain = Sheets("Main").Range("L20")
  If SaveAsUI = False Then
    Application.EnableEvents = False
    If WorksheetFunction.Or(shinfo = "", shmain = "") Then
        MsgBox "These cells have not probably been filled in !" _
      & vbCrLf & "Blad ""Info"" " & shinfo.Address _
      & vbCrLf & "Blad ""Main"" " & shmain.Address, vbExclamation, "LOOK OUT !"
      Cancel = True
     ElseIf GetTargetFileName <> ThisWorkbook.Name Then
        SaveMyFile
        Cancel = True
     End If
  End If
  Application.EnableEvents = True
End Sub

en in Module1:

Code: 
Option Explicit
Public shinfo As Range, shmain As Range
Sub SaveMyFile()

Dim Retval As Variant
 
With Application
 Retval = .GetSaveAsFilename(GetTargetFileName, , 2, "Select your folder and adjust the filename if necessary !")
 MsgBox "Done! Saved as: " & ThisWorkbook.Path & "\" & ThisWorkbook.Name
 If Retval <> False Then
    ThisWorkbook.SaveAs Retval
 End If
End With

End Sub

Function GetTargetFileName() As String
    GetTargetFileName = "Design Summary - " & shinfo & " - " & Format(shmain, "00w00d0") & ".xlsm"
End Function

gewoon ter info. misschien zijn jullie iets met die informatie en kunnen jullie er ook iets uit leren

PS deze oplossing gevonden via Google op een ander forum

toch nogmaals heel erg bedankt aan iedereen die mee hielp aan mijn probleem
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan