-
[vba]
Sub GemSom()
Dim ws As Worksheet
Set ws = Sheets("Kasserapport")
If Test(ws) = True Then
With Sheets("Kasserapport")
ActiveWorkbook.SaveAs CheckMakePath("G:\" & .Range("H5").Text & "-huset" & "\" & "Beboere" & "\" & _
.Range("D2").Text & "\" & "Regnskab" & "\" & _
Format(.Range("A4"), "yyyy") & _
"Regnskab " & Format(.Range("A4"), "mm-yyyy") & _
" " & .Range("D2").Text & ".xls")
End With
Else
MsgBox "Please fill fields"
End If
End Sub
Function Test(ws As Worksheet) As Boolean
If ws.Range("A4") <> "" And ws.Range("D2") <> "" Then Test = True
End Function
Function CheckMakePath(ByVal vPath As String) As String
Dim PathSep As Long, oPS As Long
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
PathSep = InStr(3, vPath, "\") 'Position af drev-seperatoren i stien
If PathSep = 0 Then Exit Function 'Ugyldig sti
Do
oPS = PathSep
PathSep = InStr(oPS + 1, vPath, "\") 'Position af folder
If PathSep = 0 Then Exit Do
If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do 'check stien
Loop
Do Until PathSep = 0
MkDir Left(vPath, PathSep)
oPS = PathSep
PathSep = InStr(oPS + 1, vPath, "\")
Loop
CheckMakePath = vPath
End Function
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules