28.11.2013

Zusätzlich beim speichern ein Tabellenblatt als PDF ablegen...

Frage: Ein bestimmtes Tabellenblatt soll zusätzlich zum speichern der Excel Datei noch als PDF gespeichert werden. Eine vorhandene PDF-Datei soll ohne Nachfrage überschrieben werden. Wie geht das?

One particular worksheet is in addition to save the Excel file be saved as a PDF. An existing PDF file will be overwritten without prompting. How does it work?

Hier noch eine Beispieldatei / Here's a sample file:
Zusätzlich beim speichern ein Tabellenblatt als PDF ablegen...[ZIP 80 KB]

Code gehört in "DieseArbeitsmappe" / Code belongs in "ThisWorkbook":

Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Declare Function PathFileExists Lib "shlwapi.dll" _
    Alias "PathFileExistsA" (ByVal pszPath As String) As Long
' Pfad für die PDF-Datei MIT abschliessendem Backslash anpassen!!!!
Const strPDFPath As String = "C:\Temp\"
'--------------------------------------------------------------------------
' Module    : ThisWorkbook
' Procedure : Workbook_BeforeSave
' Author    : Case (Ralf Stolzenburg)
' Date      : 28.11.2013
' Purpose   : Always save as PDF in particular folder...
'--------------------------------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    ' Name des Tabellenblattes anpassen!!!!!
    With ThisWorkbook.Worksheets("Sheet1")
        ' Prüfen ob Ordner vorhanden ist
        If PathFileExists(strPDFPath) <> 0 Then
            ' PDF-Datei im vorgegebenen Pfad erstellen - NUR ein Tabellenblatt
            ' Dateiname ist wie Exceldateiname mit Datum und Uhrzeit
            '.ExportAsFixedFormat 0, strPDFPath & fncEXT(.Parent.Name) & _
                Format(Now, "_YYYY_MM_DD_hh_mm_ss")
            ' Dateiname ist wie Exceldateiname VORHANDENE DATEI WIRD ERSETZT
            .ExportAsFixedFormat 0, strPDFPath & fncEXT(.Parent.Name)
            ' PDF-Datei im vorgegebenen Pfad erstellen - NUR ein Tabellenblatt
            ' Dateiname ist wie Worksheetname mit Datum und Uhrzeit
            '.ExportAsFixedFormat 0, strPDFPath & .Name & _
                Format(Now, "_YYYY_MM_DD_hh_mm_ss")
            ' Dateiname ist wie Worksheetname VORHANDENE DATEI WIRD ERSETZT
            '.ExportAsFixedFormat 0, strPDFPath & .Name
        Else
            ' Pfad anlegen
            MakeSureDirectoryPathExists (strPDFPath)
            ' PDF-Datei im vorgegebenen Pfad erstellen
            .ExportAsFixedFormat 0, strPDFPath & fncEXT(.Parent.Name) & _
                Format(Now, "_YYYY_MM_DD_hh_mm_ss")
        End If
        Application.Run ("Module1.Main")
    End With
Fin:
    ' Die Applikation aufwecken
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = lngCalc
        .DisplayAlerts = True
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
' Name und Extension trennen
Function fncEXT(ByVal strName As String) As String
    fncEXT = Mid(strName, 1, InStr(strName, ".") - 1)
End Function

Code gehört in ein Modul (Modul1) / Code belongs in a module (Module1):

Option Explicit
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 28.11.2013
' Purpose   : Ausblenden Druckvorschaulinien. Hide print preview lines...
'--------------------------------------------------------------------------
Private Sub Main()
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        ' Die Druckvorschaulinien ausblenden
        wksSheet.DisplayAutomaticPageBreaks = False
    Next wksSheet
End Sub

22.11.2013

PDF-Dateien öffnen - auch wenn in Unterordner...

Frage: In einem Tabellenblatt habe ich in einer Spalte Nummern stehen. Es befinden sich im gleichen Ordner wie die Exceldatei PDF-Dateien. PDF-Dateien können aber auch noch in einem Unterordner sein. Diese PDF-Dateien haben den gleichen Namen wie die Nummern in Excel. Wie kann ich die PDF-Dateien öffnen?

In a worksheet I have in a column numbers. There are in the same folder as the Excel file PDF files. But PDF files can also be in a subfolder. These PDF files have the same name as the numbers in Excel. How can I open the PDF files?

Hier noch eine Beispieldatei / Here's a sample file:
PDF-Dateien öffnen - auch wenn in Unterordner...[ZIP 800 KB]

Option Explicit
' Bedingte Kompilierung - wenn 64 Bit dann...
#If Win64 Then
    Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" _
        (ByVal RootPath As String, ByVal InputPathName As String, _
        ByVal OutputPathBuffer As String) As Long
' ... sonst...
#Else
    Private Declare Function SearchTreeForFile Lib "imagehlp.dll" _
        (ByVal RootPath As String, ByVal InputPathName As String, _
        ByVal OutputPathBuffer As String) As Long
#End If
' Bedingte Kompilierung - wenn 64 Bit dann...
#If Win64 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
        ByVal lpParameters As String, ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
        ByVal lpParameters As String, ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long
#End If
Private Const SW_MAXIMIZE = 3
' Dateierweiterung gegebenenfalls anpassen!!!
Const strEX As String = ".pdf"
'--------------------------------------------------------------------------
' Module    : Sheet1
' Procedure : BeforeDoubleClick
' Author    : Case (Ralf Stolzenburg)
' Date      : 22.11.2013
' Purpose   : Open PDF files - even if in subfolder...
'--------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Variablendeklaration
    ' Stringvariable mit Puffer
    Dim strPathName As String * 255
    Dim strName As String
    Dim lngTMP As Long
    On Error GoTo Fin
    ' Einschränkung auf Spalte 3 = C
    If Not Intersect(Target, Columns(3)) Is Nothing Then
        ' Nach Doppelklick auf Zelle NICHT in den Bearbeitungsmodus wechseln
        Cancel = True
        ' Datei suchen, wenn gefunden ist der Rückgabewert ein Long ungleich 0
        lngTMP = SearchTreeForFile(ThisWorkbook.Path & _
            Application.PathSeparator, Target.Text & _
            strEX, strPathName)
        If lngTMP = 0 Then
            ' Datei nicht vorhanden!
            MsgBox "File not found!"
        Else
            ' Puffer zurechtstutzen, überflüssige Leerzeichen weg
            strPathName = Left$(strPathName, InStr(1, strPathName, vbNullChar) - 1)
            strName = RTrim(strPathName)
            ' Datei öffnen
            ShellExecute 0, "Open", strName, "", "", SW_MAXIMIZE
        End If
    End If
Fin:
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...