Speichern unter Zelleninhalt

Forumthread: Speichern unter Zelleninhalt

24.06.2014 16:30:57

Tom

Hallo,
ich benötige eine Makro mit dem ich über einen Button das Speichern unter einen vorgegebenen Pfad z.B. C:\Test und dem Inhalt der Zelle A2 + A3 mit Ausschluß von Sonderzeichen wie z.B "/" abspeichern kann. Falls di Datei bereits vorhanden ist, soll nachgefragt werden überschreiben ja/nein und sollten die Zellen leer sein, soll der Hinweis kommen "Inhalt leer, speichern nicht möglich" oder so ähnlich.
Bitte um Unterstützung
danke
gruß Tom

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Speichern unter Zelleninhalt

24.06.2014 17:51:00

ransi
AW: Speichern unter Zelleninhalt

25.06.2014 09:17:07

Tom
AW: Speichern unter Zelleninhalt

26.06.2014 09:55:06

fcs
AW: Speichern unter Zelleninhalt

30.06.2014 08:22:16

Tom

AW: Speichern unter Zelleninhalt

24.06.2014 17:51:00

ransi

HAllo Tom
Nimm als Ansatz mal sowas:

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub aufruf()
    Const PFAD As String = "C:\Test\"
    Dim Dateiname As String
    With Sheets("Tabelle1")
        Dateiname = .Range("A2").Text & .Range("A3").Text
    End With
    If Dateiname <> "" Then
        If erlaubt(Dateiname) = True Then
            On Error Resume Next
            ThisWorkbook.SaveAs Filename:=PFAD & Dateiname & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
        Else:
        MsgBox "A2 & A3 =""""", , "Speichern nicht möglich"
    End If
End Sub

Public Function erlaubt(strText As String) As Boolean
    'CON , PRN, AUX, CLOCK$, NUL # VERBOTEN #
    'COM0 , COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9 # VERBOTEN #
    'LPT0, LPT1, LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, und LPT9 # VERBOTEN #
    '< > ? " : | \ / # VERBOTEN #
    'Leerzeichen oder Punkt # VERBOTEN #
    Dim Regex
    erlaubt = True
    Set Regex = CreateObject("Vbscript.regexp")
    With Regex
        .Pattern = "^(CON|PRN|AUX|CLOCK$|NUL|COM0|COM1|COM2|COM3|COM4|COM5|COM6|COM7|COM8|COM9|LPT0|LPT1|LPT2|LPT3|LPT4|LPT5|LPT6|LPT7|LPT8| LPT9)\..*$"
        If .test(strText) = True Then
            erlaubt = False
            Exit Function
        End If
        .Pattern = "(<|>|\?|""|:|\||\\|\/|\*)"
        .Global = True
        If .test(strText) = True Then
            erlaubt = False
            Exit Function
        End If
        .Pattern = "( |\.).*\..*$"
        If .test(strText) = True Then
            erlaubt = False
            Exit Function
        End If
    End With
End Function

ransi

AW: Speichern unter Zelleninhalt

25.06.2014 09:17:07

Tom

Hallo Ransi,
ok so weit ganz gut. Ich habe mich aber falsch geäußert. Die Sonderzeichen sollten durch ein Leerzeichen oder ähnli. ersetzt oder ignoriert werden.
Kannst du mir die bitte Function noch einmal anpassen?
danke
gruß Tom

AW: Speichern unter Zelleninhalt

26.06.2014 09:55:06

fcs

Hallo Tom,
mit Ersetzen von unzulässigen/unerwünschten Zeichen kann es wie folgt ausehen.
Als Ersetzungszeichen hab ich "_" gewählt. Das kannst du aber beliebig anpassen.
Tabellenname und Zellen mit den Dateinamens-Teilen muss du anpassen.
Gruß
Franz

Public Sub aufruf()
Const PFAD As String = "D:\Test\"
Dim Dateiname As String
With Sheets("Tabelle1")
Dateiname = .Range("A2").Text & .Range("A3").Text
End With
If Dateiname  "" Then
Dateiname = fncErsetzenUnzulaessig(Dateiname) & ".xlsm"
If Dir(PFAD & Dateiname)  "" Then
If MsgBox("Datei """ & Dateiname & """ existiert schon!" & vbLf _
& "Datei überschreiben?", _
vbYesNo + vbQuestion, _
"Datei speichern unter") = vbNo Then Exit Sub
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=PFAD & Dateiname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
Else
MsgBox "A2 & A3 =""""", , "Speichern nicht möglich"
End If
End Sub
Public Function fncErsetzenUnzulaessig(ByVal strText As String, _
Optional strSub As String = "_") As String
' Ersetzen von unzulässigen/unerwünschten  Zeichen in Dateinamen
Dim arrZeichen, intJ As Integer, strName As String
arrZeichen = Array("", "?", """", ":", "|", "\", "/") 'unzulässige Zeichen
strName = strText
For intJ = LBound(arrZeichen) To UBound(arrZeichen)
strName = VBA.Replace(Expression:=strName, Find:=arrZeichen(intJ), Replace:=strSub, _
Start:=1)
Next
fncErsetzenUnzulaessig = strName
End Function

AW: Speichern unter Zelleninhalt

30.06.2014 08:22:16

Tom

Hallo Franz,
super!! passt....
Danke
gruß Tom

Beliebteste Forumthreads (12 Monate)

Forumthread: Speichern unter Zelleninhalt

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread