|
本帖最后由 feiaoli 于 2024-1-20 13:20 编辑
1、EXCEL2003转成EXCEL2013(或比2007更高版本)的代码
2、另外工作表加上保护密码。
3、原始表格密码没有
4、想转换excel高版本的原因是:好多电脑不能用这个小程序
谢谢各位老师
- Sub 保存()
- 'ActiveSheet.Unprotect "1234" '解除工作表保护1234是保护密码
- Dim X As Integer '解除所有工作表保护
- For X = 1 To Sheets.Count '解除所有工作表保护
- Sheets(X).Unprotect '解除所有工作表保护
- Next X '解除所有工作表保护
- If Application.CountA(Sheets("excel预算单位项目资金支出计划申请书").Range("a4:f4")) < Sheets("excel预算单位项目资金支出计划申请书").Range("a4:f4").Count Then
- Cancel = True
- MsgBox "完善相关数据后再打印保存"
- Else
- ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '打印
- Sheets("excel预算单位项目资金支出计划申请书").Select
- lastrow = Sheets("excel预算单位项目资金支出计划数据库").Cells(Rows.Count, "a").End(3).Row + 1
- With Sheets("excel预算单位项目资金支出计划数据库")
- .Cells(lastrow, 2) = [b2].Value
- .Cells(lastrow, 3) = [E2].Value
- .Cells(lastrow, 4) = [B3].Value
- .Cells(lastrow, 5) = [D3].Value
- .Cells(lastrow, 6) = [F3].Value
- .Cells(lastrow, 7) = [B4].Value
- .Cells(lastrow, 8) = [D4].Value
- .Cells(lastrow, 9) = [f4].Value
- .Cells(lastrow, 10) = Replace(Range("a5"), Chr(10), "") '[a5].Value
- .Cells(lastrow, 11) = [H2].Value
- .Cells(lastrow, 1) = [h1].Value
- For n = 1 To 10
- .Cells(lastrow, n + 11) = Cells(n + 12, "m")
- Next n
- End With
- Worksheets("excel预算单位项目资金支出计划申请书").[h1] = Left(Worksheets("excel预算单位项目资金支出计划申请书").[h1].Value, 1) & Format(Right(Worksheets("excel预算单位项目资金支出计划申请书").[h1].Value, 3) + 1, "20240000")
- Worksheets("excel预算单位项目资金支出计划申请书").Range("e2:f2,b3,d3,f3,b4,d4,f4").ClearContents '清除选中单元格
- Worksheets("excel预算单位项目资金支出计划申请书").Range("a5") = " "
- Worksheets("excel预算单位项目资金支出计划申请书").[f4].Select
- Application.ScreenUpdating = True
- End If
- ThisWorkbook.Save
- 'ActiveSheet.Protect "1234" '工作表保护1234是保护密码
- Dim b As Integer '保护所有工作表
- For b = 1 To Sheets.Count '保护所有工作表
- Sheets(b).Protect '保护所有工作表
- Next b '保护所有工作表
- End Sub
复制代码- Sub 保存()
- Dim X As Integer '解除所有工作表保护
- For X = 1 To Sheets.Count '解除所有工作表保护
- Sheets(X).Unprotect '解除所有工作表保护
- Next X '解除所有工作表保护
- If Application.CountA(Sheets("excel项目申请审批单").Range("a2:a7")) < Sheets("excel项目申请审批单").Range("a2:a7").Count Then
- Cancel = True
- MsgBox "完善相关数据后再打印保存"
- Else
- ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '打印
- Sheets("excel项目申请审批单").Select
- lastrow = Sheets("excel项目申请审批单库").Cells(Rows.Count, "a").End(3).Row + 1
- With Sheets("excel项目申请审批单库")
- .Cells(lastrow, 2) = [a2].Value
- .Cells(lastrow, 3) = [a3].Value
- .Cells(lastrow, 4) = [a4].Value
- .Cells(lastrow, 5) = [a5].Value
- .Cells(lastrow, 6) = [a6].Value
- .Cells(lastrow, 7) = [a7].Value
- .Cells(lastrow, 8) = [H2].Value
- .Cells(lastrow, 1) = [h1].Value
- For n = 1 To 10
- .Cells(lastrow, n + 9) = Cells(n + 10, "m")
- Next n
- End With
- Worksheets("excel项目申请审批单").[h1] = Left(Worksheets("excel项目申请审批单").[h1].Value, 1) & Format(Right(Worksheets("excel项目申请审批单").[h1].Value, 3) + 1, "00000000")
- 'Worksheets("excel项目申请审批单").Range("a2:a5=0,a7=0").ClearContents '清除选中单元格
- Worksheets("excel项目申请审批单").Range("a2") = " " '给单元格赋值
- Worksheets("excel项目申请审批单").Range("a3") = " "
- 'Worksheets("excel项目申请审批单").Range("a4") = " "
- Worksheets("excel项目申请审批单").Range("a5") = " "
- Worksheets("excel项目申请审批单").Range("a7") = " "
- Worksheets("excel项目申请审批单").Range("a8") = " "
- Worksheets("excel项目申请审批单").[f4].Select
- Application.ScreenUpdating = True
- End If
- ThisWorkbook.Save
- Dim b As Integer '保护所有工作表
- For b = 1 To Sheets.Count '保护所有工作表
- Sheets(b).Protect '保护所有工作表
- Next b '保护所有工作表
- End Sub
复制代码
|
|