我尝试了很多不同的想法,但我仍然陷入困境。我是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
当前结果:
预期结果:
答案 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