VBA code Werblad opslaan als

[oceanrace]

[COLOR="yellow"]Sub Opslaanzonderformules()[/COLOR]
  Dim strFileName As Variant, strPath As String
  Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & [AJ2], _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
        With .Sheets("blad1")
            .Unprotect
            .UsedRange.Value = .UsedRange.Value
            .Protect
        End With
     Set VBProj = .VBProject
     For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    .SaveAs Filename:=strFileName
End With
  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub

Ik krijg een compileerfout...

 

[Warme bakkertje]

Zijn alle benodigde verwijzingen aangevinkt ?
Hier werkt het feilloos, dus in de code zelf zit er geen fout.

 

[oceanrace]

alleen de bovenste 5 zijn aangevinkt, is dat niet genoeg?
Ik krijg de melding dat een door de gebruiker gedefinieerd gegevenstype niet is gedefinieerd.

Groet,
Bas

 

[Warme bakkertje]

Deze verwijzing moet je opzoeken en aanvinken

Microsoft Visual Basic For Applications Extensibility 5.3

 

[oceanrace]

Het werkt!
Maar moet dit op elke PC ingeschakeld worden? Mijn collega's werken er ook mee, wordt lastig uitleggen telkens...

Bedankt voor je hulp!

Groet,
Bas

 

[Warme bakkertje]

Het moet inderdaad op elke PC ingeschakeld worden, maar met onderstaande in ThisWorkbook zou dat automatisch moeten verlopen bij het openen v/h bestand.

Private Sub Workbook_Open()
Dim CheckRefNormal_ As Boolean
CheckRefNormal_ = False
For i = 1 To ThisWorkbook.VBProject.References.Count
    If ThisWorkbook.VBProject.References(i).Name = "VBIDE" Then CheckRefNormal_ = True
Next
Err.Clear
If CheckRefNormal_ = False Then
    ThisWorkbook.VBProject.References _
        .AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 1, 0
End If
End Sub

 

[oceanrace]

With ActiveWorkbook
    With .Sheets("blad1")
        .Unprotect
        .UsedRange.Value = .UsedRange.Value
        .Protect
    End With
    .SaveAs Filename:=strFileName
End With

Deze code slaat een beveiligd blad zonder wachtwoord op.
Maar als ik een wachtwoord wil gebruiken werkt het niet, is hier een mogelijkheid voor?

 

[Warme bakkertje]

Door in je VB-Editor op F1 te drukken had je deze zelf ook kunnen vinden, nietwaar

With ActiveWorkbook
    With .Sheets("blad1")
        .Unprotect [COLOR="red"]"Zet hier je wachtwoord"[/COLOR]
        .UsedRange.Value = .UsedRange.Value
        .Protect [COLOR="red"]"Zet hier je wachtwoord"[/COLOR]
    End With
    .SaveAs Filename:=strFileName
End With

 

[oceanrace]

Ik had het al geprobeerd via F1 maar was de aanhalingstekens vergeten.

In ieder geval bedankt!

 

[oceanrace]

Sub Opslaanzonderformules()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "niet opgeslagen.", vbInformation + vbOKOnly, "Oeps, er is iets misgegaan..."
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    With .Sheets("blad1")
        .Unprotect "wachtwoord"
        .UsedRange.Value = .UsedRange.Value
        .Protect "wachtwoord"
    End With
    .SaveAs Filename:=strFileName
End With
  MsgBox "opgeslagen als: " & strFileName, vbInformation + vbOKOnly, "Gelukt"
 
  End If
End Sub

Is het mogelijk om in deze code nog uit te breiden met het volgende:
Origineel bestand sluiten en opnieuw openen.

Dit zou ik graag willen omdat ik telkens nadat blad1 is opgeslagen, weer met een schone lei wil beginnen.

 

[Warme bakkertje]

Het is nogal moeilijk om een bestand waarin je code zit zichzelf terug te laten openen, nietwaar
Wat moet er gebeuren met blad1 om terug met een propere lei te beginnen ? Je zal het eerder in die richting moeten zoeken.

 

[oceanrace]

Het betreft een formulier met veel formules die door invullen "kapot" gaat.
Ik sla het na invullen dus op met bovenstaande macro onder een andere naam, daarna begin ik opnieuw door het origineel helemaal af te sluiten om hem vervolgens weer te openen.

 

[Warme bakkertje]

Is het dan niet interessanter om een kopie van je 'maagdelijk schoon' formulier te bewaren op een apart tabblad en na het invullen dit te kopieëren naar je origineel blad om terug schoon te kunnen verdergaan ?
Of bestaat de mogelijkheid om je formulier zogezegd te resetten naar nul ?

 

[oceanrace]

Kun je een blad resetten naar 0 middels een knop?

 

[Warme bakkertje]

Zo zonder voorbeeld is het een beetje moeilijk antwoorden, maar ik heb hier al rare dingen zien klaarspelen

 

[oceanrace]

Hallo forummers,

In deze VBA code zoek in nog een extra optie;

Ik wil graag van Sheets ("kaart") dat opgeslagen moet worden een range selecteren ipv het hele werkblad, namelijk "A1:AB56".

Sub Opslaanzonderformules()
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = Range("AJ2").Value
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & strFileName, _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "De kaart is niet opgeslagen!", vbInformation + vbOKOnly, "Oeps, er is iets misgegaan..."
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    With .Sheets("kaart")
        .Unprotect "ww"
        .UsedRange.Value = .UsedRange.Value
        .Protect "ww"
    End With
    .SaveAs Filename:=strFileName
End With
  A = MsgBox("Wil je deze kaart ook printen ? Hierna wordt de opgeslagen kaart vanzelf afgesloten. ", vbYesNo, "Gelukt, de kaart is opgeslagen!")

If A = vbYes Then
    
     Application.Dialogs(xlDialogPrinterSetup).Show
     ActiveSheet.PrintOut

End If
     
     ActiveWorkbook.Close Savechanges:=False



  End If
End Sub

Wie weet raad?
Is er ook iemand die weet waarom je de printopdracht Application.Dialogs(xlDialogPrinterSetup).Show niet kunt cancellen? Hij print dan alsnog....

 

[Warme bakkertje]

Application.Dialogs(xlDialogPrinterSetup).Show

Deze opent het dialoogvenster om je printerinstellingen te wijzigen en niet je dialoogvenster om het printen te sturen.
Gebruik onderstaande en verwijder de rode regel.

Application.Dialogs(xlDialogPrint).Show
[COLOR="red"]ActiveSheet.PrintOut[/COLOR]

 

[oceanrace]

Ik had zelf deze gevonden, werkt ook.

Dim res As Boolean
res = Application.Dialogs(xlDialogPrinterSetup).Show
 MsgBox "Het printen is geannuleerd!", vbInformation + vbOKOnly, "Let op"

Die van jou ga ik nu proberen.
bedankt

Ik zoek nu nog een oplossing om een range "A1:AB56" te selecteren in activesheet

    ActiveSheet.Copy
    With ActiveWorkbook
    With .Sheets("kaart")