"Oplsaan als" en als .xlsm

[tonissteiner]

Hallo,

ik ben op zoek naar een code om mijn document te beveiligen tegen opslaan. het zou alleen als "opslaan als" mogen weg geschreven worden en het moet ook onder de extensie .xlsm of ik verlies de macros die erin zitten.

ik vond wel al onder andere (en vele andere codes ook) hier op dit forum:

'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Application.Dialogs (xlDialogSaveAs)
'End Sub

echter als ik deze in mijn Excel 2010 gebruik loopt Excel telkens vast en sluit hij vanzelf.

iemand enig idee hoe hij mij toch kan helpen met een andere code?

 

[tonissteiner]

ik heb ondertussen een werkende code gevonden:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim varWorkbookName As String, FileFormatValue As Integer
    On Error GoTo Quit
    Application.EnableEvents = False
    If SaveAsUI = False Then
        varWorkbookName = Application.GetSaveAsFilename( _
        FileFilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm", _
        Title:="Select your folder and adjust the filename if necessary!")
        Cancel = True
        If varWorkbookName <> "False" Then
            Select Case LCase(Right(varWorkbookName, Len(varWorkbookName) - InStrRev(varWorkbookName, ".", , 1)))
            Case "xlsm": FileFormatValue = 52
            End Select
        ActiveWorkbook.SaveAs varWorkbookName
        MsgBox "Done! Saved as: " & varWorkbookName
        End If
    End If
Quit:
    If Err.Number > 0 Then
        If Err.Number <> 1004 Then
            MsgBox "Error: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & _
            "Title", vbCritical
        End If
    End If
    Application.EnableEvents = True
End Sub

met dank aan Warme Bakkertje die in vorige post het grootste gedeelte van de code geschreven heeft.

Nu zou ik graag nog de code aangepast zien zodat er eerst een aantal vaste woorden in de file name komt, dan de waarde van een cel op een bepaald blad en dan ook nog de iso datum (eigenlijk is dat ook de waarde uit een bepaalde cel want die bereken ik daar al.

Met andere woorden zou de standaard file name al moeten zijn:

Design Summary - HP100_05098 - 12w19d2.xlsm

waarbij:
"Design Summary" een vaste tekst is
"HP100_05098" komt uit cel D6 van blad "Info"
"12w19d2" eigenlijk dan ook komt uit cel L20 van blad "Main"

is er iemand die me kan helpen deze (voor mij ingewikkelde code) aan te passen?

alvast bedankt

 

[HSV]

Even een vraagje tonissteiner.
Werkt de code in Excel 2010 ?
Met het oog op "fileformatvalue:= 52"
Ik weet dat het voor een .xlsm extensie is, maar ik dacht voor Excel 2007.
+3 zou dan voor Excel 2010 zijn.
Ik verneem het graag van je.

Hier zit ook bijna alles in;

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 If SaveAsUI Then
   Cancel = True
    On Error Resume Next
     ThisWorkbook.SaveAs "D:\" & Sheets(1).Range("A1") & ".xlsm", 52
 End If
End Sub

 

[tonissteiner]

goede avond Harry,

het is een code die ik hier vond en heb er nu al wat testen met gedaan en nog geen problemen ondervonden. Dus neem ik aan dat ze wel werkt. De code in de eerste post die ik hier plaatse daar liep Excel op vast.

ik probeer jouw code even uit nu

alvast bedankt

 

[tonissteiner]

Even (met de nodige aanpassingen) getest en op zich werkt de code wel maar het is niet wat ik beoogde te doen.
het opslaan als een .xlsm is al ok en ook de naam halen uit cel A1
het is de bedoeling echter als er op save geklikt zou worden dat het eigenlijk een save as is en er dan al de naam "Design Summary - HP100_05098 - 12w19d2.xlsm" zou komen te staan
in die langere code stonden ook nog die msg boxen die wel handig zijn

 

[HSV]

Waar moet het komen te staan ?
In de filedialog ?, zodat je het nog kan veranderen ?

 

[tonissteiner]

hallo Harry,

ja inderdaad. dank je

 

[tonissteiner]

ik zit hier zelf maar te proberen en te pogen (allé meer klooien dus) maar lukt mij niet

 

[tonissteiner]

Het moet wel ergens in een combinatie liggen van zoiets als deze lijn

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("A1").Value & " - " & Range("A2").Value & " - " & Range("A3").Value & ".xlsm"

of deze iets gelijkaardig aan deze lijn

With Sheets("Info")
        ActiveWorkbook.SaveAs Filename:= _
        .[A1] & " " & [A2] & " " & [A3] & ".xlsm"
End With

maar het lukt me niet ze in te bouwen in mijn eerder geposte code en ook niet om te verwijzen naar die twee verschillende cellen in die 2 verschillende sheets

 

[tonissteiner]

via deze code:

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Design Summary" & " - " & Sheets("Info").[D6].Value & " - " & Sheets("Main").[L20].Value & ".xlsm"

krijg ik al dit resultaat:

Design Summary - HP100_05098 - 12193.xlsm

echter de w en de d staat niet tussen de datum. moet de format van de cel hierin overgenomen worden? hoe doe ik dit? zodat ik dit krijg: Design Summary • HP100_05098 • 12w19d3.xlsm

dit is natuurlijk maar een halve code. Excel vraagt niet om op te slaan maar slaat direct op. deze tekst zou als default moeten weergegeven worden. graag wat hulp om die code aan te passen

 

[tonissteiner]

is mijn vraag te moeilijk?

 

[HSV]

Je vraag was niet moeilijk voor een .xls extensie, die had ik een half jaar geleden of zo al klaar gehad.
Maar ja, .xlsm weigerde steeds aan de opslaan-knop.

Test het eens.

 

[tonissteiner]

Hallo Harry,

bedankt voor je moeite alvast. heel knap gedaan. ik merk nog wel een foutje op. je moet eens proberen met de file in bijlage. hierin genereer ik die speciale datum en als je die dan gebruikt om op te slaan zet hij enkel getallen, zonder de letters.

Bekijk bijlage SaveAs.xlsm

In een andere post die ik hier ondertussen al plaatste (omdat ik ook nog steeds aan het proberen was) gaven Jan en Leo al een oplossing. het topic heeft als titel "VBA opslaan met waarde uit cel onder custom formaat" post 703363. maar het lukt mij weer niet die te verwerken in jouw code.

nog een ander probleem die ik ondervond in jouw code is dat hij nog steeds de mogelijkheid laat op te slaan als iets anders dan een .xlsm (en gaf dat zelfs ook niet als default extensie)
en ook ik kon het eigenlijk niet opslaan. het venster sloot maar als ik ging kijken in de dir stond het bestand er niet.

ik weet niet of jij ook met de 2010 werkt en of het daar dan zou kunnen aan liggen

maar alvast nogmaals heel hartelijk bedankt

 

[tonissteiner]

Goede morgen Harry,

net nog even jouw bestandje uitgeprobeerd en zelfde resultaat als gisteren. heb jouw bestand 1 op 1 genomen en enkel die 2 cellen eens een andere naam gegeven. de extensie die er automatisch achter gezet is is .xlsx en eens op de knop save gedrukt staat de file ook niet in de aangeduide folder

 

[HSV]

Zo moet het beter gaan.
Standaard wordt er nu de extensie ".xlsm" in het venster weergegeven.
Ook wordt de format van cel L20 meegenomen in het venster.

 

[tonissteiner]

Hallo Hary,

sorry voor mijn late reactie. respect voor je, je hebt weer heel mooi werk geleverd. ik heb echter nog steeds één probleem. alles gaat perfect tot je op de knop save drukt, echter het bestand vind ik dan niet terug in de folder die ik geselecteerd heb. ik heb de waarde in cel D6 aangepast (datum deed excel automatisch omdat we dag later zijn), de naam die hij weergeeft en extensie is perfect, selecteer de folder... klik save... het venster sluit.... maar vind het bestand niet terug.

enig idee wat dit zou kunnen zijn?

maar alvast nogmaals enorm bedankt al

 

[Warme bakkertje]

Ik begrijp het eigenlijk niet goed, je wil opslaan onder een welbepaalde naam maar toch wil je de SaveAsDialogScreen om eventueel te kunnen wijzigen ??

 

[tonissteiner]

Hallo Rudi,

ja inderdaad. Zoals Harry het al opstelde is eigenlijk perfect (uitgenomen dat zijn code voorlopig, bij mij, nog geen bestand wegschrijft/aanmaakt). Uit 2 verschillende bladen uit een cel een waarde halen en die dan samenvoegen met een standaard tekst en deze dan als suggestie weergeven. met de mogelijkheid nog zelf een folder aan te duiden.

omschrijf ik het verkeerd omdat je me niet begrijpt?

 

[HSV]

Jammer dat het bij jou niet werkt, en ik zou ook niet weten wat er aan te doen.
Naar het bureaublad werkt het perfect bij mij.
Zelfs naar twee mappen (map binnen een map) werkt het perfect.

Misschien is er iemand die het even wil testen.

Ik heb Windows Xp met Excel 2007, maar of dat er mee van doen heeft ?

 

[tonissteiner]

Hallo Harry,

ja bizar. maar zoals je hier al gelezen hebt heb ik wel meer problemen met die 2010 versie. jij hebt dus ook al die cel D6 gewijzigd? ik start even mijn andere computer op en probeer het ook eens naar het bureaublad op te slaan. op deze computer heb ik maar een 2003