使用VBA向动态范围SQL查询添加边框

时间:2018-01-18 22:17:40

标签: excel vba excel-vba

我尝试了很多不同的想法,但我仍然陷入困境。我是VBA的新手,所以我无法弄清楚如何得到我需要的东西,因为我并不完全理解这种语言。

我希望在返回到查询的数据中的每个单元格周围添加边框(外部和内部)。如何将其写入代码?我将附上一张用户希望看到的图片。

这就是我所拥有的:

Sub Button1_Click()

Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."

' Remove any values in the cells where we want to put our Stored Procedure's results.
Dim rngRange As Range
Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
rngRange.ClearContents

' Log into our SQL Server, and run the Stored Procedure
con.Open "Provider=XXXXXXetc"

' Set up the parameter for our Stored Procedure
' (Parameter types can be adVarChar,adDate,adInteger)
cmd.Parameters.Append cmd.CreateParameter("Assembly", adVarChar, adParamInput, 10, Range("B1").Text)

Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "Custom.PRO_BOM_XXXX"
Set rs = cmd.Execute(, , adCmdStoredProc)

' Copy the results to cell B7 on the first Worksheet
Set WSP1 = Worksheets(1)
WSP1.Activate
If rs.EOF = False Then WSP1.Cells(8, 2).CopyFromRecordset rs

rs.Close
Set rs = Nothing
Set cmd = Nothing

con.Close
Set con = Nothing

Application.StatusBar = "Data successfully updated."





End Sub

当前结果:

Current Outcome

预期结果:

Expected Outcome

2 个答案:

答案 0 :(得分:0)

你想要这样的东西:

Sub Button1_Click()
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim WSP1 As Worksheet
    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Application.DisplayStatusBar = True
    Application.StatusBar = "Contacting SQL Server..."

    ' Remove any values in the cells where we want to put our Stored Procedure's results.
    Dim rngRange As Range
    Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
    rngRange.ClearContents

    ' Log into our SQL Server, and run the Stored Procedure
    con.Open "Provider=XXXXXXetc"

    ' Set up the parameter for our Stored Procedure
    ' (Parameter types can be adVarChar,adDate,adInteger)
    cmd.Parameters.Append cmd.CreateParameter("Assembly", adVarChar, adParamInput, 10, Range("B1").Text)

    Application.StatusBar = "Running stored procedure..."
    cmd.CommandText = "Custom.PRO_BOM_XXXX"
    Set rs = cmd.Execute(, , adCmdStoredProc)

    ' Copy the results to cell B7 on the first Worksheet
    Set WSP1 = Worksheets(1)
    '
    If rs.EOF then
        Application.StatusBar = ""
        GoTo Closedown
    End If
    Dim NumRows As Integer, EndRow As Integer, EndCol As Integer
    EndCol = 12 ' You can adjust this
    NumRows = rs.RecordCount
    EndRow = 7 + NumRows ' - Adjust the number 7 if you ever decide to start pasting from 8
    ' Do the paste
    WSP1.Cells(8, 2).CopyFromRecordset rs
    ' Now set the range:
    Dim PastedRange As Range
    With WSP1
        Set PastedRange = .Range(.Cells(8, 2), .Cells(EndRow, EndCol))
    End With
    '
    PastedRange.Borders.Color = vbBlack ' Thanks for the tip, sktneer
    '
    Application.StatusBar = "Data successfully updated."
Closedown:
    rs.Close: Set rs = Nothing
    Set cmd = Nothing
    con.Close: Set con = Nothing
End Sub

答案 1 :(得分:0)

感谢大家的帮助。这就是我为工作解决方案所做的设计:

Sub Button1_Click()


Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."
Set WSP1 = Worksheets(1)
WSP1.Activate

' Remove any values in the cells where we want to put our Stored Procedure's results.
Dim rngRange As Range
Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
rngRange.ClearContents
rngRange.ClearFormats

' Log into our SQL Server, and run the Stored Procedure
con.Open "Provider=SQLOLEDB;Data Source=XXXXX;Initial Catalog=XXXXX;Integrated Security=SSPI;Trusted_Connection=Yes"
cmd.ActiveConnection = con

Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "PRO_BOM_XXXXX"
Set rs = con.Execute("Exec Custom.PRO_XXXXX '" & ActiveSheet.Range("B1").Value2 & "','" & ActiveSheet.Range("B2").Value2 & "'")

' Copy the results to cell B7 on the first Worksheet
Set WSP1 = Worksheets(1)
If rs.EOF Then
    Application.StatusBar = ""
    GoTo Closedown
End If
Dim EndCol As Integer
EndCol = 14
WSP1.Cells(8, 2).CopyFromRecordset rs

'find the last row
Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
    End With
' Now set the range:
Dim PastedRange As Range
With WSP1
    Set PastedRange = .Range(.Cells(8, 2), .Cells(LastRow, EndCol))
End With

'Add borders
PastedRange.Borders.Color = vbBlack

Application.StatusBar = "Data successfully updated."


Closedown:
rs.Close: Set rs = Nothing
Set cmd = Nothing
con.Close: Set con = Nothing

End Sub