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

Foutmelding

Status
Niet open voor verdere reacties.
deSmid

deSmid

Gebruiker
Lid geworden
6 jun 2001
Berichten
307
Het volgende heb ik ingevoerd:

Sub Bewaar()
' Sneltoets: CTRL+SHIFT+B
Dim sText As String

sText = "PL " & ActiveSheet.Range("b1").Value & ".xls"
ActiveWorkbook.SaveAs sText
End Sub

In 'b1' staat een waarde die binnen mijn werkblad onder bepaalde omstandigheden kan veranderen en werkt op zich goed. Echter als deze macro wordt uitgevoerd en de naam van het werkblad komt overeen met een bestaand werkblad krijg ik de melding dat deze al bestaat en of ik deze wil overschrijven. Dit moet ook eigenlijk altijd en geeft geen probleem. Maak ik de keuze dit niet te doen of annuleren krijg ik een foutmelding en kom ik in VBA foutopsporen. Hoe kan ik dit ondervangen?

Vrgrt,
deSmid.
 
Zou dit een oplossing zijn?

Sub Bewaar()
' Sneltoets: CTRL+SHIFT+B
Dim sText As String

sText = "PL " & ActiveSheet.Range("b1").Value & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sText
Application.DisplayAlerts = True
End Sub

Luc
 
Ben hier al heel blij mee. Alleen jammer dat ik nu ook de vraag niet krijg of ik het werkblad wil vervangen of niet.
Is hier nog een andere oplossing voor te bedenken?

Mvrgrt,
deSmid
 
Foutmelding nog niet weten op te lossen. Als, zoals de bedoeling is, bevestigend wordt beantwoord is er geen probleem en werkt de oplossing dus prima.
Voor de rest, 'foutje moet kunnen'.

Nogmaals bedankt Luc,

Groet,
deSmid.
 
Hoi, Was vraag even uit het oog verloren:

Sub Bewaar()
' Sneltoets: CTRL+SHIFT+B
Dim sText As String

If msgBox("Wenst u het bestand te overschrijven?", vbYesNo) = vbYes Then
sText = "PL " & ActiveSheet.Range("b1").Value & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sText
Application.DisplayAlerts = True
End If

End Sub

Luc
 
Dit is wel een aardige en voor het gebruik een betere oplossing. Hiermee wordt de eigenlijke foutmelding ondervangen maar meld nu of het bestaande bestand moet worden vervangen ook als dit nog NIET bestaat. Geen probleem, het werkt in ieder geval zonder foutmelding. Moet het t.b.v. een extra kopie nog onder een andere naam of locatie kan dit altijd nog via het menu, bestand opslaan als.......

Bedankt.
deSmid.
 
Als je het zelf uit gaat spreken wordt het een stuk makkelijker voor jezelf om er achter te komen wat er eventueel zou moeten gebeuren. Uiteraard moet je wel es een macro'tje hebben geschreven... ;)

If....... Then......
...............
Else
...............
End If

Snap je wat ik bedoel?
 
Nee, dit snap ik niet.
Maak je zelf wat duidelijker a.u.b.

deSmid.
 
Sub Bewaar()
' Sneltoets: CTRL+SHIFT+B
Dim sText As String

If msgBox("Wenst u het bestand te overschrijven?", vbYesNo) = vbYes Then
sText = "PL " & ActiveSheet.Range("b1").Value & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sText
Application.DisplayAlerts = True
Else
Exit Sub
End If
End Sub

Zo iets?
 
Ik had al een vaag vermoeden welke kant het moest opgaan.
Helaas, het resultaat is niet beter dan de oplossing van Luc en daar kan ik mee leven.
Het maakt ook hier niet uit of het bestand wel of niet bestaat en maak ik een (extra) kopie (of onder andere naam) via het menu - bestand opslaan als......
Het is natuurlijk wel zo dat via ELSE dit nog is toe te voegen.
(Misschien dat ik dat eens ga proberen dit macro'tje aan te passen):cool:

Mvrgrt,
deSmid.
 
Ik hoop dat je er uit komt. Ik heb het probleem nog even aan een bekende van moi voorgelegd en die zal er hopelijk nog even voor je naar kijken. :thumb:
 
Hai Luc (how's life?) & Jay, (hier ben ik al) ;)

Smid,

Volgens mij wil jij het zo:
Code: 
Sub SaveTheFile()
Dim sPath As String
Dim sRoot As String
 
 On Error GoTo Oops
 sRoot = Application.DefaultFilePath
 If Right(sRoot, 1) <> "\" Then sRoot = sRoot & "\"
 
 sPath = sRoot & "PL " & ActiveSheet.Range("b1").Value & ".xls"
 
    If fExists(sPath) Then
        If MsgBox("Wenst u het bestand te overschrijven?", vbYesNo) = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs sPath
        End If
    Else
        ActiveWorkbook.SaveAs sPath
    End If
Oops:
If Application.DisplayAlerts = False Then Application.DisplayAlerts = True
End Sub

Public Function fExists(ByVal sFile As String) As Boolean
  If Len(sFile) = 0 Then Exit Function: fExists = False
  
    If Dir(sFile, vbDirectory) <> "" Then
      fExists = True
    Else
      fExists = False
    End If
    
End Function

In de bijlage zit een voorbeeld welke direct kunt uitvoeren en testen...

Veel succes! :thumb:
 

Bijlagen

Ik durf het haast niet meer te zeggen, maar ......
Ligt het mogelijk dan toch aan het fijt dat ik Office 2000 gebruik ( op Windows ME)?

Eerste keer opslaan werkt. De tweede keer krijg ik de melding dat het bestand al bestaat en of ik deze wil overschrijven. Dit werkt ook, ik kan het overschrijven of via Nee weer terug in mijn werkblad en krijg helaas niet de vraag/mogelijkheid een andere naam in te voeren.

Zoals al eerder gezegd, ik kan er mee leven en lig er niet van wakker. Natuurlijk blijft het leuk als er echt een oplossing voor te bedenken is.

Zeker blijf ik alle inzet waarderen en groet ik allen,
deSmid.
:)
 
Hai, :D

Overal is een oplossing voor. Helaas wist/begreep ik niet dat jij na de optie Nee ook graag een vraag wilde krijgen of je het Bestand onder een andere naam op kunt slaan.

Natuurlijk kan dat.
De aangepaste code:
Code: 
Sub SaveTheFile()
Dim sPath As String
Dim sRoot As String
 
 On Error GoTo Oops
 sRoot = Application.DefaultFilePath
 If Right(sRoot, 1) <> "\" Then sRoot = sRoot & "\"
 
 sPath = sRoot & "PL " & ActiveSheet.Range("b1").Value & ".xls"
 
    If fExists(sPath) Then
        If MsgBox("Wenst u het bestand te overschrijven?", vbYesNo) = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs sPath
        Else
            If MsgBox("Wenst u het bestand onder een andere naam op te slaan?", vbYesNo) = vbYes Then
                sPath = sRoot & InputBox("Geef de naam") & ".xls"
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs sPath
            End If
        End If
    Else
        ActiveWorkbook.SaveAs sPath
    End If
Oops:
If Application.DisplayAlerts = False Then Application.DisplayAlerts = True
End Sub

Public Function fExists(ByVal sFile As String) As Boolean
  If Len(sFile) = 0 Then Exit Function: fExists = False
  
    If Dir(sFile, vbDirectory) <> "" Then
      fExists = True
    Else
      fExists = False
    End If
    
End Function

Mochten hier nog aanvullingen/wensen op komen dan hoor ik het graag.

Zie bijlage voor code in actie! :thumb:
 

Bijlagen

Niets meer aan toe te voegen, perfect.

Op naar de volgende vraag.

Mijn dank is groot,
deSmid.:thumb:
 
Geplaatst door deSmid
Niets meer aan toe te voegen, perfect.

Op naar de volgende vraag.

Mijn dank is groot,
deSmid.:thumb:
Klik om te vergroten...
Hai, :D

Fijn om te horen graag gedaan! :thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan