[已解决]如何实现复制时将格式也复制过来 麻烦帮忙修改一下代码

追月狼123

各位前辈，初学者，不懂代码。如何修改代码后，可以将外币格式复制过来。谢谢各位了

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-30 09:21

1. Sub hanzhen2()
   
2. 'Sheets("客户信息表").Select
   
3. '有ThisWorkbook中的工作簿事件，此处无须再选中工作表．否则必须保证＂客户信息表＂为活动工作表该程序才能执行．
   
4.     Dim UserRange As Range
   
5.     On Error GoTo Canceled
   
6.     Set UserRange = Application.InputBox _
   
7.                     (Prompt:="请选择客户:", _
   
8.                      Title:="提示：", _
   
9.                      Type:=8)
   
10.     With Worksheets("客户信息表")
    
11. 
    
12.         TEMPbianhao = .Cells(UserRange.Row, 1).Value
    
13.         TEMPmingcheng1 = .Cells(UserRange.Row, 3).Value
    
14.         TEMPqian = .Cells(UserRange.Row, 4).Value
    
15.         TEMPshe = .Cells(UserRange.Row, 6).Value
    
16.         TEMPshe2 = .Cells(UserRange.Row, 7).Value
    
17.         TEMPshe3 = .Cells(UserRange.Row, 5).Value
    
18.         TEMPUNIT = .Cells(UserRange.Row, 9).Value
    
19.         str4 = .Cells(UserRange.Row, 4).NumberFormatLocal
    
20.         str5 = .Cells(UserRange.Row, 5).NumberFormatLocal
    
21.         str6 = .Cells(UserRange.Row, 6).NumberFormatLocal
    
22.         str7 = .Cells(UserRange.Row, 7).NumberFormatLocal
    
23.     End With
    
24. 
    
25.     If Worksheets("客户信息表").Cells(UserRange.Row, 2).Value = "√" Then
    
26. 
    
27.         On Error Resume Next
    
28.         If Len(Worksheets(TEMPmingcheng1).Name) = 0 Then
    
29.             Worksheets("企业询证函模板").Copy after:=Worksheets(Worksheets.Count)
    
30.             Set newsheet = ActiveSheet
    
31.             Err.Clear
    
32.         Else
    
33.             Set newsheet = Worksheets(TEMPmingcheng1)
    
34.         End If
    
35.         With mySheet
    
36.             .Name = TEMPmingcheng1
    
37.             .Range("A3").FormulaR1C1 = "致:" & TEMPmingcheng1
    
38.             .Range("E2").FormulaR1C1 = "编号:" & "OOO" & TEMPbianhao
    
39.             .Range("B13").FormulaR1C1 = "截止日期:" & "2012年12月31日"
    
40.             .Range("C14").FormulaR1C1 = TEMPqian
    
41.             .Range("C14").NumberFormatLocal = str4
    
42.             .Range("E15").FormulaR1C1 = TEMPshe
    
43.             .Range("E15").NumberFormatLocal = str6
    
44.             .Range("E14").FormulaR1C1 = TEMPshe2
    
45.             .Range("E14").NumberFormatLocal = str7
    
46.             .Range("C15").FormulaR1C1 = TEMPshe3
    
47.             .Range("C15").NumberFormatLocal = str5
    
48.             .Range("D21").FormulaR1C1 = TEMPUNIT
    
49.         End With
    
50.     Else
    
51.         MsgBox Prompt:="此客户无需函证！", Title:="友情提示："
    
52.     End If
    
53. 
    
54.     mySheet.PrintPreview
    
55.     Worksheets("客户信息表").Activate
    
56. Canceled:
    
57. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub hanzhen2()
   
2. 'Sheets("客户信息表").Select
   
3. '有ThisWorkbook中的工作簿事件，此处无须再选中工作表．否则必须保证＂客户信息表＂为活动工作表该程序才能执行．
   
4.     Dim UserRange As Range
   
5.     On Error GoTo Canceled
   
6.     Set UserRange = Application.InputBox _
   
7.                     (Prompt:="请选择客户:", _
   
8.                      Title:="提示：", _
   
9.                      Type:=8)
   
10.     With Sheets("客户信息表")
    
11. 
    
12.         TEMPbianhao = .Cells(UserRange.Row, 1).Value
    
13.         TEMPmingcheng1 = .Cells(UserRange.Row, 3).Value
    
14.         TEMPqian = .Cells(UserRange.Row, 4).Value
    
15.         TEMPshe = .Cells(UserRange.Row, 6).Value
    
16.         TEMPshe2 = .Cells(UserRange.Row, 7).Value
    
17.         TEMPshe3 = .Cells(UserRange.Row, 5).Value
    
18.         TEMPUNIT = .Cells(UserRange.Row, 9).Value
    
19.         str4 = .Cells(UserRange.Row, 4).NumberFormatLocal
    
20.         str5 = .Cells(UserRange.Row, 5).NumberFormatLocal
    
21.         str6 = .Cells(UserRange.Row, 6).NumberFormatLocal
    
22.         str7 = .Cells(UserRange.Row, 7).NumberFormatLocal
    
23.     End With
    
24.     If Sheets("客户信息表").Cells(UserRange.Row, 2).Value = "√" Then
    
25. 
    
26. 
    
27.         Set mySheet = Worksheets.Add(Type:=xlWorksheet, after:=Sheets(Sheets.Count))
    
28. 
    
29. 
    
30.         Sheets("企业询证函模板").Select
    
31.         Cells.Select
    
32.         Selection.Copy
    
33.         mySheet.Select
    
34.         Cells.Select
    
35.         Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    
36.                                False, Transpose:=False
    
37. 
    
38. 
    
39. 
    
40.         With mySheet
    
41.             .Name = TEMPmingcheng1
    
42.             .Range("A3").FormulaR1C1 = "致:" & TEMPmingcheng1
    
43.             .Range("E2").FormulaR1C1 = "编号:" & "OOO" & TEMPbianhao
    
44.             .Range("B13").FormulaR1C1 = "截止日期:" & "2012年12月31日"
    
45.             .Range("C14").FormulaR1C1 = TEMPqian
    
46.             .Range("C14").NumberFormatLocal = str4
    
47.             .Range("E15").FormulaR1C1 = TEMPshe
    
48.             .Range("E15").NumberFormatLocal = str6
    
49.             .Range("E14").FormulaR1C1 = TEMPshe2
    
50.             .Range("E14").NumberFormatLocal = str7
    
51.             .Range("C15").FormulaR1C1 = TEMPshe3
    
52.             .Range("C15").NumberFormatLocal = str5
    
53.             .Range("D21").FormulaR1C1 = TEMPUNIT
    
54.         End With
    
55.     Else: MsgBox Prompt:="此客户无需函证！", Title:="友情提示："
    
56.     End If
    
57. 
    
58.     mySheet.PrintPreview
    
59.     Sheets("客户信息表").Select
    
60. Canceled:
    
61. End Sub
    

复制代码

hwc2ycy

复件 企业函证定稿.rar (19.38 KB, 下载次数: 6)

2013-5-30 07:14 上传

点击文件名下载附件

追月狼123

hwc2ycy 发表于 2013-5-30 07:14

十分感谢您的帮助

hwc2ycy

其实自定义格式就是单元格的NumberFormatLocal

另外你的代码里，如果重复生成报告就出错了，这个没有做判断。

追月狼123

hwc2ycy 发表于 2013-5-30 07:14

麻烦问一下，在生成多个函证时，如何不复制模版

追月狼123

hwc2ycy 发表于 2013-5-30 08:23
其实自定义格式就是单元格的NumberFormatLocal

另外你的代码里，如果重复生成报告就出错了，这个没有做判 ...

就是要求不允许重复生成报告

hwc2ycy

你把原来的代码都换掉。

1. Sub hanzheng1()
   
2. 
   
3.     Dim Msg, Style, Title, Response
   
4.     Dim TEMPA As String
   
5.     Msg = "是否函证?"
   
6.     Style = vbYesNo
   
7.     Title = "请确认"
   
8.     If MsgBox(Msg, Style, Title) = vbYes Then
   
9. 
   
10.         For i = 4 To Worksheets("客户信息表").Range("a1").CurrentRegion.Rows.Count
    
11.             With Worksheets("客户信息表")
    
12.                 TEMPbianhao = .Cells(i, 1).Value
    
13.                 TEMPmingcheng = .Cells(i, 3).Value
    
14.                 TEMPqian = .Cells(i, 4).Value
    
15.                 TEMPshe = .Cells(i, 6).Value
    
16.                 TEMPshe2 = .Cells(i, 7).Value
    
17.                 TEMPshe3 = .Cells(i, 5).Value
    
18.                 TEMPUNIT = .Cells(i, 9).Value
    
19. 
    
20.                 str4 = .Cells(i, 4).NumberFormatLocal
    
21.                 str5 = .Cells(i, 5).NumberFormatLocal
    
22.                 str6 = .Cells(i, 6).NumberFormatLocal
    
23.                 str7 = .Cells(i, 7).NumberFormatLocal
    
24.             End With
    
25.             If Worksheets("客户信息表").Cells(i, 2).Value = "√" And Worksheets("客户信息表").Cells(i, 3).Value <> "" Then
    
26.                 Dim newsheet As Worksheet
    
27.                 On Error Resume Next
    
28.                 If Len(Worksheets(TEMPmingcheng).Name) = 0 Then
    
29.                     Worksheets("企业询证函模板").Copy after:=Worksheets(Worksheets.Count)
    
30.                     Set newsheet = ActiveSheet
    
31.                     Err.Clear
    
32.                 Else
    
33.                     Set newsheet = Worksheets(TEMPmingcheng)
    
34.                 End If
    
35.                 On Error GoTo 0
    
36.                 With newsheet
    
37.                     .Name = TEMPmingcheng
    
38.                     .Range("A3").FormulaR1C1 = "致:" & TEMPmingcheng
    
39.                     .Range("e2").FormulaR1C1 = "编号:" & "OOO" & TEMPbianhao
    
40.                     .Range("b13").Formula = "截止日期:" & "2012年12月31日"
    
41.                     .Range("c14").FormulaR1C1 = TEMPqian
    
42.                     .Range("e15").FormulaR1C1 = TEMPshe
    
43.                     .Range("e14").FormulaR1C1 = TEMPshe2
    
44.                     .Range("c15").FormulaR1C1 = TEMPshe3
    
45.                     .Range("d21").FormulaR1C1 = TEMPUNIT
    
46.                     .Range("C14").NumberFormatLocal = str4
    
47.                     .Range("E15").NumberFormatLocal = str6
    
48.                     .Range("E14").NumberFormatLocal = str7
    
49.                     .Range("C15").NumberFormatLocal = str5
    
50.                 End With
    
51.             End If
    
52.         Next i
    
53.     End If
    
54. End Sub

复制代码

hwc2ycy

1. Sub hanzhen2()
   
2. 'Sheets("客户信息表").Select
   
3. '有ThisWorkbook中的工作簿事件，此处无须再选中工作表．否则必须保证＂客户信息表＂为活动工作表该程序才能执行．
   
4.     Dim UserRange As Range
   
5.     On Error GoTo Canceled
   
6.     Set UserRange = Application.InputBox _
   
7.                     (Prompt:="请选择客户:", _
   
8.                      Title:="提示：", _
   
9.                      Type:=8)
   
10.     With Worksheets("客户信息表")
    
11. 
    
12.         TEMPbianhao = .Cells(UserRange.Row, 1).Value
    
13.         TEMPmingcheng1 = .Cells(UserRange.Row, 3).Value
    
14.         TEMPqian = .Cells(UserRange.Row, 4).Value
    
15.         TEMPshe = .Cells(UserRange.Row, 6).Value
    
16.         TEMPshe2 = .Cells(UserRange.Row, 7).Value
    
17.         TEMPshe3 = .Cells(UserRange.Row, 5).Value
    
18.         TEMPUNIT = .Cells(UserRange.Row, 9).Value
    
19.         str4 = .Cells(UserRange.Row, 4).NumberFormatLocal
    
20.         str5 = .Cells(UserRange.Row, 5).NumberFormatLocal
    
21.         str6 = .Cells(UserRange.Row, 6).NumberFormatLocal
    
22.         str7 = .Cells(UserRange.Row, 7).NumberFormatLocal
    
23.     End With
    
24. 
    
25.     If Worksheets("客户信息表").Cells(UserRange.Row, 2).Value = "√" Then
    
26. 
    
27.         On Error Resume Next
    
28.         If Len(Worksheets(TEMPmingcheng1).Name) = 0 Then
    
29.             Worksheets("企业询证函模板").Copy after:=Worksheets(Worksheets.Count)
    
30.             Set newsheet = ActiveSheet
    
31.             Err.Clear
    
32.         Else
    
33.             Set newsheet = Worksheets(TEMPmingcheng1)
    
34.         End If
    
35.         With mySheet
    
36.             .Name = TEMPmingcheng1
    
37.             .Range("A3").FormulaR1C1 = "致:" & TEMPmingcheng1
    
38.             .Range("E2").FormulaR1C1 = "编号:" & "OOO" & TEMPbianhao
    
39.             .Range("B13").FormulaR1C1 = "截止日期:" & "2012年12月31日"
    
40.             .Range("C14").FormulaR1C1 = TEMPqian
    
41.             .Range("C14").NumberFormatLocal = str4
    
42.             .Range("E15").FormulaR1C1 = TEMPshe
    
43.             .Range("E15").NumberFormatLocal = str6
    
44.             .Range("E14").FormulaR1C1 = TEMPshe2
    
45.             .Range("E14").NumberFormatLocal = str7
    
46.             .Range("C15").FormulaR1C1 = TEMPshe3
    
47.             .Range("C15").NumberFormatLocal = str5
    
48.             .Range("D21").FormulaR1C1 = TEMPUNIT
    
49.         End With
    
50.     Else
    
51.         MsgBox Prompt:="此客户无需函证！", Title:="友情提示："
    
52.     End If
    
53. 
    
54.     mySheet.PrintPreview
    
55.     Worksheets("客户信息表").Activate
    
56. Canceled:
    
57. End Sub
    

复制代码

hwc2ycy

修改了下，对于已经有存在的询证函，直接修改内容，不再重新生成。