我有一个电子表格,其中有两个按钮 - 一个用于从数据库检索记录,另一个用于将更改从Excel上传到数据库。从数据库检索记录的宏如下所示。现在,在检索记录后,我希望用户仅编辑某些列(这里是从1月到情景的列),以便用户在更新这些单元格后可以单击更新按钮将更改保存到数据库中。但是,我不希望他们触及其他列(EmpID到Status)。我想要一个宏,可以在数据检索后锁定这些列,并在单击检索按钮时解锁这些列。这是因为每当我点击检索记录按钮时,我都会清除工作表。我尝试了几种方法,但没有成功。我将感激您的帮助。
感谢您的来信,Hema。
Public Sub RetrieveDBToWorkSheet()
Dim sQry As String
Dim iRows As Integer
Dim iCols As Integer
Dim SQL As String
On Error GoTo ErrHandler
'Clear worksheet
Call ClearExistingRows(4)
'Create ADODB Recordset for retrieved data
Call DBConnection.OpenDBConnection
'Create Recordset
Dim rsMY_Resources As ADODB.Recordset
Set rsMY_Resources = New ADODB.Recordset
SQL = "SELECT EmpID, EName, CCNum, CCName, ProgramNum, ProgramName, ResTypeNum, ResName, Status, January, February, March, April, May, June, July, August, September, October, November, December, Total_Year, Year, Scenario from Actual_FTE2"
'Query the database
rsMY_Resources.Open SQL, DBConnection.oConn, adOpenStatic, adLockReadOnly
If rsMY_Resources.EOF = True Then
MsgBox ("No record found in database")
Exit Sub
End If
'Fill excel active sheet, starting from row# 3
iRows = 3
For iCols = 0 To rsMY_Resources.Fields.Count - 1
ActiveSheet.Cells(iRows, iCols + 1).Value = rsMY_Resources.Fields(iCols).Name
Next
ActiveSheet.Range(ActiveSheet.Cells(iRows, 1), ActiveSheet.Cells(iRows, rsMY_Resources.Fields.Count)).Font.Bold = True
iRows = iRows + 1
ActiveSheet.Range("A" + CStr(iRows)).CopyFromRecordset rsMY_Resources
iRows = rsMY_Resources.RecordCount
'Clean up
rsMY_Resources.Close:
Set rsMY_Resources = Nothing
Call DBConnection.CloseDBConnection
MsgBox (CStr(iRows) + " records have been retrieved from the database!")
Exit Sub
ErrHandler:
MsgBox (Error)
End Sub
Public Sub ClearExistingRows(lRowStart As Long)
Dim lLastRow As Long
Dim iLastCol As Integer
If (Not (Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious)
Is Nothing)) Then
lLastRow = Cells.Find("*", Range("A1"), xlFormulas, ,
xlByRows,xlPrevious).Row ' Find the last row with data
If (lLastRow >= lRowStart) Then
iLastCol = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns,
xlPrevious).Column ' Find the last column with data
Range(Cells(lRowStart, 1), Cells(lLastRow, iLastCol)).Select
Selection.EntireRow.Delete
End If
End If
End Sub
感谢您的来信,Hema。