Attribute VB_Name = "Module"
Sub InitControlBar()
    
    On Error GoTo Nextt
    
        Call Application.ActiveWorkbook.VBProject.References.AddFromGuid("{67EA4C27-A47C-11D6-9500-00065B874123}", "3", "0")
Nextt:
    Call DeleteControlBar("Сохранение")
    Application.CommandBars.Add(Name:="Сохранение", Position:=msoBarTop, Temporary:=True).Visible = True
    
 
    With Application.CommandBars("Сохранение").Controls.Add(Type:=msoControlButton, Before:=1)
        .FaceId = 1650
        .Style = msoButtonIcon
        .Caption = "Отображать пустые строки"
        .OnAction = "ShowEmptyRow(True)"
    End With
    
    With Application.CommandBars("Сохранение").Controls.Add(Type:=msoControlButton, Before:=1)
        .FaceId = 1649
        .Style = msoButtonIcon
        .Caption = "Не отображать пустые строки"
        .OnAction = "ShowEmptyRow(False)"
    End With
    
    With Application.CommandBars("Сохранение").Controls.Add(Type:=msoControlButton, Before:=1)
        .FaceId = 1653
        .Style = msoButtonIcon
        .Caption = "Отображать пустые столбцы"
        .OnAction = "ShowEmptyColumn(True)"
    End With
    
    With Application.CommandBars("Сохранение").Controls.Add(Type:=msoControlButton, Before:=1)
        .FaceId = 1652
        .Style = msoButtonIcon
        .Caption = "Не отображать пустые столбцы"
        .OnAction = "ShowEmptyColumn(False)"
    End With

End Sub

Sub DeleteControlBar(cbrname As String)
Dim Found As Boolean, cbar As Object
    Found = False
    For Each cbar In Application.CommandBars
        If cbar.Name = cbrname Then Found = True
    Next
    If Found Then Application.CommandBars(cbrname).Delete
    Set cbar = Nothing
End Sub

Sub SaveTemplate()
    Dim Saved, constr, str, con, img, cmd, cFile, RepName, cObj
    
    Saved = False
    
    
    'Считаем параметры
    cObj = Application.ActiveWorkbook.Sheets("Info").Range("B1").Value
    constr = Application.ActiveWorkbook.Sheets("Info").Range("B3").Value
    verid = Application.ActiveWorkbook.Sheets("Info").Range("B4").Value
    cFile = Application.DefaultFilePath + "\report.xlt"
    
    'Ругнемся
    If cObj = "DICTIONARY_PROJECT" Then
        RepName = Left(InputBox("Введите наименование отчета", "Сохранеие шаблона отчета", "Новый отчет"), 200)
    End If
    ActiveWorkbook.SaveCopyAs filename:=cFile
    
    
    serviceAdr = CStr(Application.ActiveWorkbook.Sheets("Info").Range("B6").Value)
    
    useProxyDefaults = CBool(Application.ActiveWorkbook.Sheets("Info").Range("B7").Value)
    proxyAdress = CStr(Application.ActiveWorkbook.Sheets("Info").Range("B8").Value)
    proxyPort = Application.ActiveWorkbook.Sheets("Info").Range("B9").Value
    proxyDomain = Application.ActiveWorkbook.Sheets("Info").Range("B10").Value
    proxyLogin = Application.ActiveWorkbook.Sheets("Info").Range("B11").Value
    proxyPass = Application.ActiveWorkbook.Sheets("Info").Range("B12").Value
    
    
    
    'Считаем файл
    Set str = CreateObject("ADODB.Stream")
    str.Type = 1
    str.Open
    
    str.Position = 0
    str.LoadFromFile (cFile)
    
    str.Position = 0
    
    img = str.Read()
    
    
    If serviceAdr = "" Then
    
        Set con = CreateObject("ADODB.Connection")
        con.Open "Provider=SQLOLEDB.1;" + constr
        Set cmd = CreateObject("ADODB.Command")
        cmd.ActiveConnection = con
        cmd.CommandType = 4
        cmd.CommandText = "LOAD_BIN_REPORT"
        Call cmd.Parameters.Refresh
        cmd.Parameters.Item(1).Value = verid
        cmd.Parameters.Item(2).Value = RepName
        cmd.Parameters.Item(3).Value = img
        Call cmd.Execute
          
        Call str.Close
        Call con.Close
            
        Call VBA.MsgBox("Шаблон сохранен.")
    Else
    
     
     Set sc_Service = New SoapClient30
     'sc_Service.MSSoapInit2 c_WSDL_URL, str_WSML, c_SERVICE, c_PORT, c_SERVICE_NAMESPACE
     sc_Service.MSSoapInit2 serviceAdr, "", "Service", "ServiceSoap", "http://keysystems.ru/"
    
     
     sc_Service.ConnectorProperty("EnableAutoProxy") = True
     sc_Service.ConnectorProperty("ProxyServer") = "<CURRENT_USER>"
       
       If CBool(useProxyDefaults) Then
                sc_Service.ConnectorProperty("EnableAutoProxy") = True
                sc_Service.ConnectorProperty("ProxyServer") = "<CURRENT_USER>"
         Else
            sc_Service.ConnectorProperty("EnableAutoProxy") = False
            sc_Service.ConnectorProperty("ProxyServer") = CStr(proxyAdress)
            sc_Service.ConnectorProperty("ProxyUser") = CStr(proxyLogin)
            sc_Service.ConnectorProperty("ProxyPassword") = CStr(proxyPass)
            'sc_Service.ConnectorProperty("ProxyDomain") = CStr(proxyDomain)
            'sc_Service.ConnectorProperty("ProxyPort") = CInt(proxyPort)
        End If
      
        On Error GoTo wsm_ExecuteTrap
        Saved = sc_Service.SaveTemplate(constr, verid, RepName, img)
        If CBool(Saved) Then
        Call VBA.MsgBox("Шаблон сохранен.")
        Else
        Call VBA.MsgBox("Неудалось сохранить шаблон")
        End If
        'Use the proxy server defined in Internet Explorer's LAN settings by
        'setting ProxyServer to <CURRENT_USER>
         'Autodetect proxy settings if Internet Explorer is set to autodetect
        'by setting EnableAutoProxy to True
        Set sc_Service = Nothing
     
    End If
    Exit Sub
wsm_ExecuteTrap:
     If sc_Service.FaultCode <> "" Then
        Err.Raise vbObjectError, str_Function, sc_Service.FaultString
    'Non SOAP Error
    Else
        Err.Raise Err.Number, str_Function, Err.Description
    End If
End Sub

Sub ShowEmptyRow(lShow As Boolean)
    Application.ActiveWorkbook.ActiveSheet.PivotTables("Результат расчета").DisplayEmptyRow = lShow
End Sub

Sub ShowEmptyColumn(lShow As Boolean)
    Application.ActiveWorkbook.ActiveSheet.PivotTables("Результат расчета").DisplayEmptyColumn = lShow
End Sub

Sub LoadSOAPLibrary()
    '{67EA4C27-A47C-11D6-9500-00065B874123}
    Dim n As Long
    For n = 1 To Application.ActiveWorkbook.VBProject.References.Count
        Debug.Print (Application.ActiveWorkbook.VBProject.References(n).GUID _
            & " --- " & Application.ActiveWorkbook.VBProject.References(n).FullPath)
    Next n
End Sub


Sub RefreshPivotTables()
Dim ws As Object, wsInfo As Object, nRes As Integer, i As Integer, xlPTVersion As Variant, _
    pc As PivotCache, pt As PivotTable

    On Error GoTo ErrInfo
    Set wsInfo = ActiveWorkbook.Sheets("Info")
    If wsInfo.Range("B1").Value <> "DICTIONARY_REPORT_TEMPLATE" Then
        On Error Resume Next
        Set ws = ActiveWorkbook.Sheets("Результат расчета")
        If ws Is Nothing Then
            On Error GoTo ErrCreate
            Set ws = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
            ws.Name = "Результат расчета"
        End If
        xlPTVersion = XlPivotTableVersionList.xlPivotTableVersionCurrent
        If Application.Version = "12.0" Then
            xlPTVersion = XlPivotTableVersionList.xlPivotTableVersion12
            Set pc = ActiveWorkbook.PivotCaches().Create(XlPivotTableSourceType.xlExternal, , xlPTVersion)
        Else
            Set pc = ActiveWorkbook.PivotCaches().Add(XlPivotTableSourceType.xlExternal)
        End If
        Call PivotCasheSettings(pc, wsInfo.Range("B3").Value, wsInfo.Range("B4").Value)
        Set pt = pc.CreatePivotTable(ws.Range("B4"), "Результат расчета", , xlPTVersion)
        If Application.Version = "12.0" Then
            pt.TableStyle2 = "PivotStyleMedium2"
        Else
            pt.Format (XlPivotFormatType.xlReport8)
        End If
        Set cr = ActiveWorkbook.Charts.Add(, , 1)
        cr.Name = "Диаграмма"
        cr.ChartType = XlChartType.xl3DColumnClustered
        cr.SetSourceData (ws.Range("B4"))
        cr.Location (XlChartLocation.xlLocationAsNewSheet)
        cr.SizeWithWindow = True
        pt.HasAutoFormat = False
        wsInfo.Range("B1").Formula = "DICTIONARY_REPORT_TEMPLATE"
        ws.Select
    End If
    For Each pc In ActiveWorkbook.PivotCaches()
        On Error GoTo ErrRefresh
        Call PivotCasheSettings(pc, wsInfo.Range("B3").Value, wsInfo.Range("B4").Value)
        Call pc.Refresh
    Next pc
    GoTo AllOk
ErrInfo:
    nRes = MsgBox("Отсутствует лист Info", vbCritical + vbOKOnly)
    GoTo AllOk
ErrCreate:
    nRes = MsgBox("Ошибка создания сводной таблицы", vbCritical + vbOKOnly)
    GoTo AllOk
ErrRefresh:
    nRes = MsgBox("Ошибка обновления сводных таблиц", vbCritical + vbOKOnly)
AllOk:
    On Error GoTo 0
End Sub


Sub PivotCasheSettings(pc As PivotCache, ConnectionString As String, CubeName As String)
    pc.Connection = ConnectionString
    pc.CommandText = CubeName
    pc.CommandType = XlCmdType.xlCmdCube
    pc.MaintainConnection = True
End Sub


