高手帮忙看看这个保存

你若

高手帮忙看看这个保存，一直实现不了。

一指禅62

1. Sub 保存并打印()
   
2.     Dim i%, a(), n%
   
3.     With Sheet1
   
4.         For i = 6 To 11
   
5.             If .Range("G" & i) <> 0 Then
   
6.                 n = n + 1: ReDim Preserve a(1 To 7, 1 To n)
   
7.                 a(1, n) = .Range("A" & i).Value '货物名称
   
8.                 a(2, n) = .Range("D" & i).Value '单位
   
9.                 a(3, n) = .Range("E" & i).Value '数量
   
10.                 a(4, n) = .Range("F" & i).Value '单价
    
11.                 a(5, n) = .Range("G" & i).Value '金额
    
12.                 a(6, n) = .Range("B3").Value    '客户名称
    
13.                 a(7, n) = .Range("H3").Value     '销货日期
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     If n > 0 Then
    
18.         Sheet2.Range("A65536").End(3).Offset(1, 0).Resize(n, 7) = _
    
19.             WorksheetFunction.Transpose(a)
    
20.         Sheet1.Range("A1:J13").PrintPreview     '预览
    
21.         'Sheet1.Range("A1:J13").PrintOut         '打印
    
22.     End If
    
23. End Sub

复制代码

一指禅62

楼主的附件中，设置了工作表保护。

你若

一指禅62 发表于 2020-2-16 14:32
楼主的附件中，设置了工作表保护。

可能是，我看看。防止修改格式的。我又重新传了一次

你若

一指禅62 发表于 2020-2-16 14:30

谢谢你，我试试看。

你若

重新传个附件，前面的有密码没有取消，这次又改进了一些。谢谢大神。

你若

一指禅62 发表于 2020-2-16 14:30

第18行有错误提示

一指禅62

你若 发表于 2020-2-16 19:47
重新传个附件，前面的有密码没有取消，这次又改进了一些。谢谢大神。

1. Sub 保存并打印()
   
2.     On Error GoTo 100
   
3.     Dim Rng As Range
   
4.     Set Rng = Sheet2.[h:h].Find(g14, LookAt:=xlWhole)
   
5.     If Not Rng Is Nothing Then
   
6.         MsgBox "已经保存过了!"
   
7.         Exit Sub
   
8.     End If
   
9.     If Sheet1.Range("G12").Value = 0 Then
   
10.         MsgBox "内容为空!"
    
11.     End If
    
12.     Dim i%, a(), n%
    
13.     With Sheet1
    
14.         For i = 6 To 11
    
15.             If .Range("G" & i) <> 0 Then
    
16.                 n = n + 1: ReDim Preserve a(1 To 8, 1 To n)
    
17.                 a(1, n) = .Range("A" & i).Value '货物名称
    
18.                 a(2, n) = .Range("D" & i).Value '单位
    
19.                 a(3, n) = .Range("E" & i).Value '数量
    
20.                 a(4, n) = .Range("F" & i).Value '单价
    
21.                 a(5, n) = .Range("G" & i).Value '金额
    
22.                 a(6, n) = .Range("B3").Value    '客户名称
    
23.                 a(7, n) = .Range("H3").Value    '销货日期
    
24.                 a(8, n) = .Range("H2").Value    '单据编号
    
25.             End If
    
26.         Next
    
27.     End With
    
28.     If n > 0 Then
    
29.         Sheet2.Range("A65536").End(3).Offset(1, 0).Resize(n, 8) = _
    
30.             WorksheetFunction.Transpose(a)
    
31.         Sheet1.Range("A1:J13").PrintPreview     '预览
    
32.         'Sheet1.Range("A1:J13").PrintOut         '打印
    
33.     End If
    
34. 100:
    
35.     If Err.Number <> 0 Then MsgBox Err.Description, , "错误提示"
    
36. End Sub

复制代码

一指禅62

你若 发表于 2020-2-16 19:48
第18行有错误提示

对不起，笔误！已修改。

一指禅62

销售开单及数据1.zip (20.97 KB, 下载次数: 18)

2020-2-17 10:37 上传

点击文件名下载附件