Sub Protect([Password], [DrawingObjects], [Contents], [Scenarios], [UserInterfaceOnly], [AllowFormattingCells], [AllowFormattingColumns], [AllowFormattingRows], [AllowInsertingColumns], [AllowInsertingRows], [AllowInsertingHyperlinks], [AllowDeletingColumns], [AllowDeletingRows], [AllowSorting], [AllowFiltering], [AllowUsingPivotTables]) Member of Excel.Worksheet如下代码:Public Function SaveToExcel() As BooleanOn Error GoTo SaveToExcelErr Dim fs As Scripting.FileSystemObject, f As File Dim checkNow As Boolean Dim objWorkSheet As Worksheet Dim objworkBook As Workbook Dim objExcel As Excel.Application Dim intI As Integer Dim rang As Range Dim arrTemp() As String Dim intRow As Integer Dim intX As Integer Dim filename As String Set objExcel = New Excel.Application Set objworkBook = objExcel.Workbooks.add Set objWorkSheet = objworkBook.Worksheets.item(1) 'Write Header For intRow = 1 To 3 'intRow = 65 'intX = 1 arrTemp = Split(arrTagExcel(intRow - 1), "|") For intX = LBound(arrTemp) + 1 To UBound(arrTemp) + 1 'With objWorkSheet.Range(Chr(intRow) & CStr(intX + 1)) With objWorkSheet.Cells(intRow, intX) If intRow = 1 Then .Font.size = 13 If intRow = 3 Then .Interior.Pattern = xlPatternGray25 .Font.Bold = True .value = arrTemp(intX - 1) .ColumnWidth = Len(arrTemp(intX - 1)) + 1.5 .Locked = True End With Next Next 'Write Content 'rows For intRow = 4 To UBound(arrTagExcel) arrTemp = Split(arrTagExcel(intRow - 1), "|") For intX = LBound(arrTemp) + 1 To UBound(arrTemp) + 1 'objWorkSheet.Range(Chr(intRow) & CStr(intX + 1)).NumberFormatLocal = "@" ' .Select.Activate = arrtemp(intI)' If intX = UBound(arrtemp) + 1 Then' Debug.Print "ok"' End If objWorkSheet.Cells(intRow, intX) = arrTemp(intX - 1) 'objWorkSheet.Range(intRow, intX + 1).Locked = False objWorkSheet.Cells(intRow, intX).Locked = False objWorkSheet.Cells(intRow, intX).NumberFormatLocal = "@" 'objWorkSheet.Cells(intRow, intX) Next 'intX = intX + 1 objWorkSheet.Cells(intRow, intX - 1).Font.Color = vbRed Next objWorkSheet.Protect "", False, True, False, False, True, True, True, False, False, False, False, True, False, False, True
'objWorkSheet.Protect lblstatus = "Finished!" Set fs = New Scripting.FileSystemObject If fs.FileExists(txtFileName) Then If MsgBox("Excel file already exists,Do you want to replace it.", vbOKCancel + vbQuestion, "Finish") = vbOK Then fs.DeleteFile txtFileName, True Else With CommonDialog1 .DialogTitle = "Please choose another directory..." .ShowSave If (.filename <> "") Then filename = .filename If InStr(filename, ".xls") > 0 Then filename = Left(filename, InStr(filename, ".xls") - 1) txtFileName.Text = filename + ".xls" End With End If End If Set f = Nothing Set fs = Nothing objworkBook.SaveAs txtFileName objExcel.Visible = True SaveToExcel = True Exit FunctionSaveToExcelErr:' If Not objExcel Is Nothing Then' objExcel.Workbooks.Close' objExcel.Quit' Set objExcel = Nothing' End IfIf Err.number = 70 Then Set itmX = lvwRst.ListItems.add(, , Err.Source + ":Save Permission Denied!The excel file has been opened already.", , 2)Else Set itmX = lvwRst.ListItems.add(, , Err.Source + ":" + Err.Description, , 2)End If End Function如果为 objWorkSheet.Protect "", False, True, False, False, True, True, True, False, False, False, False, True, False, False, True
则结果入附件1:
如果为 'objWorkSheet.Protect则结果如附件2:
但Sub Protect([Password], [DrawingObjects], [Contents], [Scenarios], [UserInterfaceOnly], [AllowFormattingCells], [AllowFormattingColumns], [AllowFormattingRows], [AllowInsertingColumns], [AllowInsertingRows], [AllowInsertingHyperlinks], [AllowDeletingColumns], [AllowDeletingRows], [AllowSorting], [AllowFiltering], [AllowUsingPivotTables])中每个参数什么意思真的还不清楚![Password] :设置保护密码
[DrawingObjects] :是否允许修改excel sheet上面的图形之类的物件
[Contents] :是否允许修改内容
[Scenarios] :?
[UserInterfaceOnly] : ?
[AllowFormattingCells] :是否允许Formatting单元格(就是是否允许对单元格进行拖拉了)
[AllowFormattingColumns] :是否允许Formatting列
[AllowFormattingRows] :是否允许Formatting行
[AllowInsertingColumns] :是否允许插入列
[AllowInsertingRows] :是否允许插入行
[AllowInsertingHyperlinks] :是否允许超链接
[AllowDeletingColumns] :是否允许删除列
[AllowDeletingRows] :是否允许删除行
[AllowSorting] :是否允许排序
[AllowFiltering] :是否允许过滤
[AllowUsingPivotTables] :?从http://www.microsoft.com/china/msdn/library/office/office/UndstaExcelObjModNETDev.mspx?mfr=true中得知:
设置 Password 参数来指定一个区分大小写的字符串，这是取消保护工作表所需要的。如果您不指定这个参数，任何人都可以取消保护工作表。
将 Contents 参数设置为 True 来保护工作表的内容（单元格）。默认值为 True，您可能永远不会改变它。
将 DrawingObjects 参数设置为 True 来保护工作表的形状。默认值为 False。
将 Scenarios 参数设置为 True 来保护工作表中的方案。默认值为 True。
将 UserInterfaceOnly 参数设置为 True 可以允许通过代码修改，但是不允许通过用户界面修改。默认值为 False，这意味着通过代码和用户界面项都不可以修改受保护的工作表。这个属性设置只适用于当前会话。如果您想让代码可以在任何会话中都可以操作工作表，那么您需要每次工作簿打开的时候添加设置这个属性的代码。
AllowFormattingCells 参数、AllowFormattingColumns 参数和前面方法语法的完整列表中所示的其余参数允许特定的格式化功能，对应于对话框中（如图 12 所示）的选项。默认情况下，所有这些属性都是 False。
本文转自kenty博客园博客，原文链接http://www.cnblogs.com/kentyshang/archive/2006/05/31/414054.html如需转载请自行联系原作者
kenty
