想转换excel高版本的原因是：好多电脑不能用这个小程序

feiaoli

1、EXCEL2003转成EXCEL2013（或比2007更高版本）的代码
2、另外工作表加上保护密码。

3、原始表格密码没有
4、想转换excel高版本的原因是：好多电脑不能用这个小程序。


谢谢各位老师

1. Sub 保存()
   
2. Dim X As Integer '解除所有工作表保护
   
3.       For X = 1 To Sheets.Count '解除所有工作表保护
   
4.           Sheets(X).Unprotect '解除所有工作表保护
   
5.       Next X '解除所有工作表保护
   
6.      If Application.CountA(Sheets("excel项目申请审批单").Range("a2:a7")) < Sheets("excel项目申请审批单").Range("a2:a7").Count Then
   
7.         Cancel = True
   
8.         MsgBox "完善相关数据后再打印保存"
   
9.      Else
   
10. ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '打印
    
11. Sheets("excel项目申请审批单").Select
    
12. lastrow = Sheets("excel项目申请审批单库").Cells(Rows.Count, "a").End(3).Row + 1
    
13. With Sheets("excel项目申请审批单库")
    
14.     .Cells(lastrow, 2) = [a2].Value
    
15.     .Cells(lastrow, 3) = [a3].Value
    
16.     .Cells(lastrow, 4) = [a4].Value
    
17.     .Cells(lastrow, 5) = [a5].Value
    
18.     .Cells(lastrow, 6) = [a6].Value
    
19.     .Cells(lastrow, 7) = [a7].Value
    
20.     .Cells(lastrow, 8) = [H2].Value
    
21.     .Cells(lastrow, 1) = [h1].Value
    
22.      For n = 1 To 10
    
23.        .Cells(lastrow, n + 9) = Cells(n + 10, "m")
    
24.     Next n
    
25. End With
    
26.     Worksheets("excel项目申请审批单").[h1] = Left(Worksheets("excel项目申请审批单").[h1].Value, 1) & Format(Right(Worksheets("excel项目申请审批单").[h1].Value, 3) + 1, "00000000")
    
27.     'Worksheets("excel项目申请审批单").Range("a2:a5=0,a7=0").ClearContents '清除选中单元格
    
28.     Worksheets("excel项目申请审批单").Range("a2") = " " '给单元格赋值
    
29.     Worksheets("excel项目申请审批单").Range("a3") = " "
    
30.     'Worksheets("excel项目申请审批单").Range("a4") = " "
    
31.     Worksheets("excel项目申请审批单").Range("a5") = " "
    
32.     Worksheets("excel项目申请审批单").Range("a7") = " "
    
33.     Worksheets("excel项目申请审批单").Range("a8") = " "
    
34.     Worksheets("excel项目申请审批单").[f4].Select
    
35. Application.ScreenUpdating = True
    
36.         End If
    
37.     ThisWorkbook.Save
    
38. Dim b As Integer '保护所有工作表
    
39.       For b = 1 To Sheets.Count '保护所有工作表
    
40.           Sheets(b).Protect '保护所有工作表
    
41.       Next b '保护所有工作表
    
42. End Sub
    

复制代码

1. Sub 保存()
   
2. 'ActiveSheet.Unprotect "1234" '解除工作表保护1234是保护密码
   
3. Dim X As Integer '解除所有工作表保护
   
4.       For X = 1 To Sheets.Count '解除所有工作表保护
   
5.           Sheets(X).Unprotect '解除所有工作表保护
   
6.       Next X '解除所有工作表保护
   
7.      If Application.CountA(Sheets("excel预算单位项目资金支出计划申请书").Range("a4:f4")) < Sheets("excel预算单位项目资金支出计划申请书").Range("a4:f4").Count Then
   
8.         Cancel = True
   
9.         MsgBox "完善相关数据后再打印保存"
   
10.      Else
    
11. ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True '打印
    
12. Sheets("excel预算单位项目资金支出计划申请书").Select
    
13. lastrow = Sheets("excel预算单位项目资金支出计划数据库").Cells(Rows.Count, "a").End(3).Row + 1
    
14. With Sheets("excel预算单位项目资金支出计划数据库")
    
15.     .Cells(lastrow, 2) = [b2].Value
    
16.     .Cells(lastrow, 3) = [E2].Value
    
17.     .Cells(lastrow, 4) = [B3].Value
    
18.     .Cells(lastrow, 5) = [D3].Value
    
19.     .Cells(lastrow, 6) = [F3].Value
    
20.     .Cells(lastrow, 7) = [B4].Value
    
21.     .Cells(lastrow, 8) = [D4].Value
    
22.     .Cells(lastrow, 9) = [f4].Value
    
23.     .Cells(lastrow, 10) = Replace(Range("a5"), Chr(10), "") '[a5].Value
    
24.     .Cells(lastrow, 11) = [H2].Value
    
25.     .Cells(lastrow, 1) = [h1].Value
    
26.      For n = 1 To 10
    
27.        .Cells(lastrow, n + 11) = Cells(n + 12, "m")
    
28.     Next n
    
29. End With
    
30.     Worksheets("excel预算单位项目资金支出计划申请书").[h1] = Left(Worksheets("excel预算单位项目资金支出计划申请书").[h1].Value, 1) & Format(Right(Worksheets("excel预算单位项目资金支出计划申请书").[h1].Value, 3) + 1, "20240000")
    
31.     Worksheets("excel预算单位项目资金支出计划申请书").Range("e2:f2,b3,d3,f3,b4,d4,f4").ClearContents '清除选中单元格
    
32.     Worksheets("excel预算单位项目资金支出计划申请书").Range("a5") = " "
    
33.     Worksheets("excel预算单位项目资金支出计划申请书").[f4].Select
    
34. Application.ScreenUpdating = True
    
35.     End If
    
36.     ThisWorkbook.Save
    
37. 'ActiveSheet.Protect "1234" '工作表保护1234是保护密码
    
38. Dim b As Integer '保护所有工作表
    
39.       For b = 1 To Sheets.Count '保护所有工作表
    
40.           Sheets(b).Protect '保护所有工作表
    
41.       Next b '保护所有工作表
    
42. End Sub

复制代码

ykcbf1100

讲真，你处理数据都是直接在单元格上操作，速度快不了。

3190496160

Sub 保存()
Application.ScreenUpdating = False
Set sh = Sheets("excel预算单位项目资金支出计划申请书")
Set Sht = Sheets("excel预算单位项目资金支出计划数据库")
Dim X As Integer '解除所有工作表保护
For X = 1 To Sheets.Count '解除所有工作表保护
    Sheets(X).Unprotect "1234" '解除所有工作表保护
Next X '解除所有工作表保护
If Application.CountA(sh.Range("a4:f4")) < sh.Range("a4:f4").Count Then
    Cancel = True
    MsgBox "完善相关数据后再打印保存"
Else
    With sh
        .PrintOut Copies:=1, Collate:=True '打印
        yj = Replace(Range("a5"), Chr(10), "")
        rr = Array([h1], [b2], [e2], [b3], [d3], [f3], [b4], [d4], [f4], yj, [h2])
    End With
    With Sht
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lastrow, 1).Resize(1, UBound(rr) + 1) = rr
    End With
    With sh
        .[h1] = Left(sh.[h1].Value, 1) & Format(Right(sh.[h1].Value, 3) + 1, "20240000")
        .Range("e2:f2,b3,d3,f3,b4,d4,f4").ClearContents '清除选中单元格
        .Range("a5") = " "
        .[f4].Select
    End With
End If
Dim b As Integer '保护所有工作表
For b = 1 To Sheets.Count '保护所有工作表
    Sheets(b).Protect "1234" '保护所有工作表
Next b '保护所有工作表
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub

3190496160

excel预算单位项目资金支出计划申请书.rar (24.94 KB, 下载次数: 10)

2024-1-21 09:29 上传

点击文件名下载附件