MyTetra Share
Делитесь знаниями!
Function
16.11.2017
08:53
Текстовые метки: Function
Раздел: VBA

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'удаление листа по имени

Function FnDeleteSh(oWb As Workbook, ByVal strShName As String) As Boolean

'отключить уведомления если включены

Dim DispAlert As Variant

blnDispAlert = Application.DisplayAlerts

If blnDispAlert Then Application.DisplayAlerts = False

With oWb

For Each oSh In .Sheets

If oSh.Name = strShName Then

oSh.Delete

FnDeleteSh = True

'вернуть уведомления(если были включены)

Application.DisplayAlerts = blnDispAlert

Exit Function

End If

Next

End With


'вернуть уведомления(если были включены)

Application.DisplayAlerts = blnDispAlert

End Function


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'проверка наличия листа в книге(если нет, то создаем)

Function FnCreateSh(oWb As Workbook, ByVal strShName As String) As Boolean

With oWb

For Each oSh In .Sheets

If oSh.Name = strShName Then FnCreateSh = True

Next

'если листа нет, то создаем

If Not FnCreateSh Then

.Sheets.Add Before:=Sheets(1)

.Sheets(1).Name = strShName

FnCreateSh = True

End If

End With

End Function


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'создание строки пути по дате и главному каталогу

'strPeriod - "d" или "w" или "m" (даты или недели или месяцы)

'dDate - дата по которой формируем каталоги

'strMainPath - стартовый каталог


Sub TestFnCreateStrPathInDate()

путь = FnCreateStrPathInDate(Now, ThisWorkbook.Path & "\FMD\", "m")

genm = FnCreateCatalog(путь)


путь = FnCreateStrPathInDate(Now, ThisWorkbook.Path & "\Events_Log\", "m")

genm = FnCreateCatalog(путь)

End Sub

Function FnCreateStrPathInDate(dDate As Date, _

strMainPath As String, _

Optional ByVal strPeriod As String = "m") As String

Dim m As Variant

Dim strSubdirectory As String

Select Case strPeriod

Case "d": strSubdirectory = Format(Now, "YYYY-MM-DD")

Case "w": strSubdirectory = Application.WeekNum(dDate)

If Len(strSubdirectory) = 1 Then strSubdirectory = "0" & strSubdirectory

strSubdirectory = "W" & strSubdirectory

Case "m": strSubdirectory = Month(dDate)

If Len(strSubdirectory) = 1 Then strSubdirectory = "0" & strSubdirectory

strSubdirectory = "M" & strSubdirectory

End Select


If Len(strMainPath) = 0 Then strMainPath = ThisWorkbook.Path

FnCreateStrPathInDate = strMainPath & "\" & strSubdirectory & "\"

End Function



'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'создание путь по текстовой строке

Function FnCreateCatalog(ByVal strPath As String) As Boolean


Dim m As Variant


On Error Resume Next

m = Split(strPath, "\", -1, vbBinaryCompare)


strPath = m(0) & "\" & m(1)

For i = LBound(m) + 2 To UBound(m)

strPath = strPath & "\" & m(i) ': Debug.Print strPath

ss = Len(Dir(strPath))

If GetAttr(strPath) > 0 Then

MkDir strPath

End If

Next i

If GetAttr(strPath) > 0 Then FnCreateCatalog = True

End Function


Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования