The code is here:
Code: Select all
Sub SliceOutViewsToExcel_InBatch()
Dim sq As Variant
Dim m As Long, n As Long
Dim ErrNum As Long
Dim sServer As String
Dim bCreateSnapshot As Boolean
Dim bDeleteEmptySheets As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'user input
sServer = [inp_TM1Server]
bCreateSnapshot = ([inp_Snapshot] = "Yes")
bDeleteEmptySheets = ([inp_DeleteEmptySheets] = "Yes")
sq = ActiveSheet.ListObjects("tbl_Views").DataBodyRange.Value
With Workbooks.Add
'create sheets and slice the data
For m = UBound(sq) To 1 Step -1
With .Sheets.Add
'naming sheets
On Error Resume Next
.Name = CleanWorksheetName(Format(m, "000") & "_" & sq(m, 2) & "_" & sq(m, 1))
If Err.Number > 0 Then
ErrNum = ErrNum + 1
.Name = "Error_" & Format(m, "000") & "_" & Format(ErrNum, "000")
Err.Clear
End If
On Error GoTo 0
'main function in this macro
Run "VUSLICE", sServer & ":" & sq(m, 1), sq(m, 2)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'snapshot
If bCreateSnapshot Then .UsedRange.Value = .UsedRange.Value
'delete empty sheets
If bDeleteEmptySheets Then
If .UsedRange.Cells.Count = 1 Then
.Delete
End If
End If
End With
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
.Sheets.Add.Cells(1).Value = "Output in the next sheets"
'SheetsInNewWorkbook should always be 1 in Excel, but for those who don't, I delete useless sheets
For m = 1 To Application.SheetsInNewWorkbook
.Sheets(.Sheets.Count).Delete
Next
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Ready", vbInformation, Application.UserName
End Sub
Function CleanWorksheetName(ByVal strName As String) As String
'Adapted (improved) from:
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=1132
Dim varBadChars As Variant
Dim varReplacementChars As Variant
varBadChars = Array(":", "/", "\", "?", "*", "[", "]")
varReplacementChars = Array("", "-", "-", "", "", "(", ")")
'correct string for forbidden characters
For m = 0 To UBound(varBadChars)
strName = Replace(strName, varBadChars(m), varReplacementChars(m))
Next
'correct string for worksheet length requirement
CleanWorksheetName = Left(strName, 31)
End Function