Question

我正在制作一份我们产品的一部分报告。这些产品中的每一个都使用excel在仪表板中显示A4页面的详细信息。

我有许多excel用于连接到我的数据库并返回数据的存储过程。然后，仪表板会自动更新此数据。

我需要为100多种产品中的每一种生成此仪表板，并将它们合并为一个文档。

但是，要更新数据，我当前必须进入每个存储过程连接并手动更新产品ID。这是一项缓慢的任务。

有没有办法使用SQL，Excel或VBA来改进这个过程？

也许是一块VBA读取产品ID列表，依次更新每个存储过程，将仪表板保存为PDF并重复？

编辑：Excel通过数据选项卡下的内置连接工具使用存储过程连接数据。

Answer 1

以下是使用productId从头开始创建SQL查询的存根：

sql = "SELECT * FROM Table1 WHERE PRODUCT_ID = " & productId
If IsMissing(trustedConnection) Then
   sConn = "OLEDB;Provider=SQLOLEDB;Data Source=" & _
                serverInstance & ";Initial Catalog=" & database & _
                ";User ID=" & userId & ";Password=" & password & ";"
Else
   sConn = "OLEDB;Provider=SQLOLEDB;Data Source=" & _
   serverInstance & ";Integrated Security=SSPI;Initial Catalog=" & _
            database & ";"
End If
'Output worksheet
Set wks = Target.Parent
With qt
    .CommandType = xlCmdSql
    .CommandText = sql
    .Name = sName
    .RefreshStyle = xlOverwriteCells
    .Refresh BackgroundQuery:=False 'Execute SQL
End With
Set qt = wks.QueryTables.Add(Connection:=sConn, Destination:=Target)

现在只需创建一个循环，然后根据需要创建尽可能多的工作表和这些SQL查询。

Answer 2

这可以帮到你：

    Sub SQL_Multi()
    '
    Dim RqSql As String, _
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2
        DicArt()
    ReDim DicArt(0)
    'create or get the article list here (you can use Add_Array_To_Dico described below)
    DicArt = Add_Array_To_Dico(Array_Articles, DicArt, 1, True)


        'Add a new connection
        'Workbooks("base.xlsx").Connections.AddFromFile "D:\Documents\DEMO.odc"
'Set your query here
RqSql_Part1 = "Select * from DataBase where ID='"
RqSql_Part2 = "' and ...."

For i = LBound(DicArt) + 1 To UBound(DicArt)
        'Here is where the query is made for each ID
        RqSql = RqSql_Part1 & DicArt(i) & RqSql_Part2         '"article reference" : you can change here to place correctly the article
        With ActiveWorkbook.Connections("DEMOtest").ODBCConnection
            .BackgroundQuery = True
            .CommandText = Array(RqSql)
            .CommandType = xlCmdSql
            .Connection = "ODBC;DSN=DEMO;UID=ID;PWD=PWD;APP=Microsoft Office 2013;WSID=CHA02KW;DATABASE=DEMO"
            .RefreshOnFileOpen = False
            .SavePassword = True
            .SourceConnectionFile = ""
            .SourceDataFile = ""
            .ServerCredentialsMethod = xlCredentialsMethodIntegrated
            .AlwaysUseConnectionFile = False
        End With
        'Refreshing connection
        ActiveWorkbook.Connections("DEMOtest").Refresh

        'Wait long enough for refreshing to be finished (5 secs here)
        DoEvents
        Application.Wait (Now + TimeValue("0:00:05"))
        DoEvents
        Sheets("Dashboard").Calculate
        DoEvents

        'Export to Pdf (correct Filename)
        Sheets("Dashboard").ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=ThisWorkbook.Path & "\All\Mains " & DicArt(i) & ".pdf", _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False

    Next i

    End Sub

使用自定义函数获取具有唯一出现次数的数组：

Public Function Add_Array_To_Dico(ByVal ArrayT As Variant, _
                                    ByVal DicoArray As Variant, _
                                    Optional ByVal ColIndex As Integer, _
                                    Optional ByVal HasHeaders As Boolean) _
                                    As Variant
Dim A()
ReDim A(0)
Dim IsInDico As Boolean
Dim CellCont As String
Dim StartRow As Integer

If IsMissing(HasHeaders) Then
    'consider there is no headers
    StartRow = 0
Else
    If HasHeaders Then
        StartRow = 1
    Else
        StartRow = 0
    End If
End If

For i = StartRow To UBound(ArrayT, 1)

    CellCont = ArrayT(i, ColIndex)
    IsInDico = False

    For k = LBound(DicoArray) To UBound(DicoArray)
        If CellCont <> DicoArray(k) Then

        Else
            'Matched with dictionnary
            IsInDico = True
            Exit For
        End If
    Next k

    If IsInDico <> False Then
        'Already in Dictionnary
    Else
        'Add in Dictionnary
        ReDim Preserve DicoArray(UBound(DicoArray) + 1)
        DicoArray(UBound(DicoArray)) = CellCont
    End If
Next i

Add_Array_To_Dico = DicoArray
End Function

自动更新Excel-SQL连接以生成多个仪表板

2 个答案: