Function Udskriv() Application.Dialogs(xlDialogPrinterSetup).Show Sheets("Ark1").PrintOut From:=1, To:=1, Copies:=1, Preview:=True, Collate:=True End Function
Function GetFileName(rngNamedCell As Range) As String Dim strSaveDirectory As String: strSaveDirectory = "" Dim strFileName As String: strFileName = "" Dim strTestPath As String: strTestPath = "" Dim strFileBaseName As String: strFileBaseName = "" Dim strFilePath As String: strFilePath = "" Dim intFileCounterIndex As Integer: intFileCounterIndex = 1
' Get the users desktop directory. strSaveDirectory = Environ("USERPROFILE") & "\Desktop\" Debug.Print "Saving to: " & strSaveDirectory
' Base file name strFileBaseName = Trim(rngNamedCell.Value) Debug.Print "File Name will contain: " & strFileBaseName
' Loop until we find a free file number Do If intFileCounterIndex > 1 Then ' Build test path base on current counter exists. strTestPath = strSaveDirectory & strFileBaseName & Trim(Str(intFileCounterIndex)) & ".pdf" Else ' Build test path base just on base name to see if it exists. strTestPath = strSaveDirectory & strFileBaseName & ".pdf" End If
If (Dir(strTestPath) = "") Then ' This file path does not currently exist. Use that. strFileName = strTestPath Else ' Increase the counter as we have not found a free file yet. intFileCounterIndex = intFileCounterIndex + 1 End If
jeg kan fint køre modulet og den gemmer fint på skrivebordet :-O , men den giver stadig 25 sider,
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.