常用代码归集

jsgj2023

==========================Part5出库单======================
Private Sub cmdClear_Click()
Range("C4:E4,B7:B16,H7:I16,E19:G19,C18:J18").ClearContents
ActiveSheet.Cells(4, 3).Activate
End Sub
Private Sub cmdReturn_Click()
主界面
End Sub
Private Sub cmdSave_Click()
Dim introw   As Integer
Dim introw1 As Integer
Dim i As Integer
Dim rngTemp As Range
Application.ScreenUpdating = False
If Sheets("出库单").Cells(4, 3) <> "" And Sheets("出库单").Cells(17, 6) <> 0 Then
    introw1 = Application.WorksheetFunction.CountA(Range("B7:B16")) + 6
    With Sheets("出库明细")
        introw = Sheets("出库明细").[D1048576].End(3).Row + 1
        .Unprotect Password:="wyh"
        .Cells(introw, 1) = Sheets("出库单").Cells(3, 9)
        .Cells(introw, 2) = Sheets("出库单").Cells(3, 5)
        .Cells(introw, 3) = Sheets("出库单").Cells(4, 3)
        .Cells(introw, 12) = Sheets("出库单").Cells(17, 6)
        .Cells(introw, 13) = Sheets("出库单").Cells(19, 5)
        .Cells(introw, 14) = Sheets("出库单").Cells(17, 6) - Sheets("出库单").Cells(19, 5)
        For i = 7 To introw1
            .Cells(introw, 4) = Sheets("出库单").Cells(i, 2)
            .Cells(introw, 5) = Sheets("出库单").Cells(i, 3)
            .Cells(introw, 6) = Sheets("出库单").Cells(i, 4)
            .Cells(introw, 7) = Sheets("出库单").Cells(i, 6)
            .Cells(introw, 8) = Sheets("出库单").Cells(i, 7)
            .Cells(introw, 9) = Sheets("出库单").Cells(i, 8)
            .Cells(introw, 10) = Sheets("出库单").Cells(i, 9)
            .Cells(introw, 11) = Sheets("出库单").Cells(i, 10)
            For j = 3 To Sheets("商品信息").[b1048576].End(3).Row
                If Sheets("商品信息").Cells(j, 2) = .Cells(introw, 4) Then
                    Sheets("商品信息").Cells(j, 12) = CCur(Sheets("商品信息").Cells(j, 12)) - .Cells(introw, 9)
                    Sheets("商品信息").Cells(j, 13) = CCur(Sheets("商品信息").Cells(j, 13)) - .Cells(introw, 11)
                    Sheets("商品信息").Cells(j, 12).Font.ColorIndex = 2
                    Sheets("商品信息").Cells(j, 13).Font.ColorIndex = 2
                    Exit For
                End If
            Next j
            introw = introw + 1
        Next i
        .Range(.Cells(2, 1), .Cells(introw - 1, 14)).Borders.LineStyle = xlContinuous
        .Protect Password:="wyh"
        .Protect DrawingObjects:=True, contents:=True, Scenarios:=True
        .EnableSelection = xlNoSelection
    End With
    ret = MsgBox("正在准备打印输出此笔记录!" & Chr(13) & Chr(13) & "按[确定]完成打印,否则请[取消]!", vbInformation + vbOKCancel, "库存管理系统")
    If ret = vbOK Then
        ActiveSheet.PrintOut
    Else
        MsgBox "若打印输出此笔记录,请按单号查询后再进行打印!", 64, "库存管理系统V3.1"
    End If
    Range("c4:e4,b7:b16,h7:i16,e19:g19,c18:j18").ClearContents
    ActiveSheet.Cells(4, 3).Activate
Else
    ret = MsgBox("没有输入必要的数据信息,不能保存此笔记录!" & Chr(13) & Chr(13) & "按[确定]可返回编辑此笔记录,否则请[取消]!", vbInformation + vbOKCancel, "库存管理系统")
    If ret = vbOK Then
        ActiveSheet.Cells(4, 3).Activate
    Else
        Range("c4:e4,b7:b16,h7:i16,e19:g19,c18:j18").ClearContents
    End If
End If
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideOption
ActiveSheet.Unprotect Password:="wyh"
    Sheets("出库单").ScrollArea = "A1:J20"
    ActiveSheet.Cells(4, 3).Activate
    ActiveSheet.Protect Password:="wyh"
    ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    r = Sheets("商品信息").[b1048576].End(3).Row
        ActiveWorkbook.Names.Add Name:="CL", RefersToR1C1:="=商品信息!R3C2:R" & r & "C7"
        introw = Sheets("部门").[b1048576].End(3).Row
        ActiveWorkbook.Names.Add Name:="BM", RefersToR1C1:="=部门!R3C2:R" & introw & "C5"
        ActiveWorkbook.Names.Add Name:="BMMC", RefersToR1C1:="=部门!R3C2:R" & introw & "C2"
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If ActiveCell.Column = 2 And (ActiveCell.Row >= 7 And ActiveCell.Row <= 16) Then
    商品列表.Show
End If
End Sub

jsgj2023

==================Part6出库明细=================
Private Sub Worksheet_Activate()
HideOption
Sheets("出库明细").ScrollArea = "a1:n1048576"
End Sub

jsgj2023

=========================part7库存汇总=============================
Private Sub Worksheet_Activate()
Dim introw As Integer
Dim introw1 As Integer
Dim introw2 As Integer
Dim introw3 As Integer
Dim introw4 As Integer
Dim i  As Integer
Application.ScreenUpdating = False
HideOption
With Sheets("库存汇总")
    .ScrollArea = "a1:o1048576"
    .Visible = True
    .Activate
    .Unprotect Password:="wyh"
    introw = 6
    introw4 = .[b1048576].End(3).Row
    If introw4 >= 6 Then Range("B6:O" & introw4 & "").Delete
    introw1 = Sheets("商品信息").[b1048576].End(3).Row
    introw2 = Sheets("入库明细").[d1048576].End(3).Row
    introw3 = Sheets("出库明细").[d1048576].End(3).Row
    For r = 3 To introw1
        .Cells(introw, 2) = Sheets("商品信息").Cells(r, 2)
        .Cells(introw, 3) = Sheets("商品信息").Cells(r, 3)
        .Cells(introw, 4) = Sheets("商品信息").Cells(r, 4)
        .Cells(introw, 5) = Sheets("商品信息").Cells(r, 5)
        .Cells(introw, 6) = Sheets("商品信息").Cells(r, 6)
        .Cells(introw, 7) = Sheets("商品信息").Cells(r, 7)
        .Cells(introw, 8) = Sheets("商品信息").Cells(r, 8)
        .Cells(introw, 9) = .Cells(introw, 8) * .Cells(introw, 7)
        introw = introw + 1
    Next r
    With ActiveWorkbook.Names
        .Add Name:="RK", RefersToR1C1:="=入库明细!R3C4:R" & introw2 & "C11"
        .Add Name:="RKS", RefersToR1C1:="=入库明细!R3C9:R" & introw2 & "C9"
        .Add Name:="RKJ", RefersToR1C1:="=入库明细!R3C11:R" & introw2 & "C11"
        .Add Name:="CK", RefersToR1C1:="=入库明细!R3C4:R" & introw3 & "C11"
        .Add Name:="CKS", RefersToR1C1:="=入库明细!R3C9:R" & introw3 & "C9"
        .Add Name:="CKJ", RefersToR1C1:="=入库明细!R3C11:R" & introw3 & "C11"
    End With
    .Cells(6, 10).Formula = "=sumif(rk,b6,rks)"
    .Cells(6, 11).Formula = "=sumif(rk,b6,rkj)"
    .Cells(6, 12).Formula = "=sumif(ck,b6,cks)"
    .Cells(6, 13).Formula = "=sumif(ck,b6,ckj)"
    .Cells(6, 14).Formula = "=h6+j6-l6"
    .Cells(6, 15).Formula = "=i6+k6-m6"
    introw4 = .[b1048576].End(3).Row
    Range("j6:o6").AutoFill Destination:=Range("j6:o" & introw4 & ""), Type:=xlFillDefault
    Range("b6:o" & introw & "").Borders.LineStyle = xlContinuous
    .Cells(6, 2).Select
    .Protect Password:="wyh"
End With
Application.ScreenUpdating = True
End Sub

jsgj2023

===========================part8供应商======================
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideOption
With Sheets("供应商")
    .ScrollArea = "a1:e1048576"
    .Unprotect Password:="wyh"
End With
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal T As Range)
Dim i As Long
Dim j   As Long
i = T.Row
j = T.Column
If Not IsEmpty(Cells(i, 2)) Then
    Range(Cells(i, 2), Cells(i, 5)).Borders.LineStyle = xlContinuous
    If j >= 5 Then
        Cells(i + 1, 1).Select
    Else
        Cells(i, j + 1).Select
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal T As Range)
Dim i As Long
Dim j As Long
i = CInt(Cells(2, 6))
j = T.Column
If T.Row > i Then
    Cells(i + 1, j).Select
End If
End Sub

jsgj2023

=====================part9主界面===========================
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideOption
ActiveWindow.ScrollColumn = 3
Sheets("主界面").ScrollArea = "D1"
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

jsgj2023

======================part10部门=====================
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideOption
With Sheets("部门")
    .ScrollArea = "a1:e1048576"
    .Unprotect Password:="wyh"
End With
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal T As Range)
Dim rngtemp   As Range
i = T.Row
j = T.Column
If Not IsEmpty(Cells(i, 2)) Then
    Range(Cells(i, 2), Cells(i, 5)).Borders.LineStyle = xlContinuous
    If j >= 5 Then
        Cells(i + 1, 2).Select
    Else
        Cells(i, j + 1).Select
    End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
Dim i   As Long
Dim j   As Long
i = CInt(Cells(2, 6))
j = T.Column
If T.Row > i Then
    Cells(i + 1, j).Select
End If
End Sub

jsgj2023

========================part11库存报警=========================
Private Sub Worksheet_Activate()
Dim introw As Integer
Dim introw1 As Integer
Dim i   As Integer
Dim j   As Integer
Application.ScreenUpdating = False
HideOption
With Sheets("库存报警")
    .Unprotect Password:="wyh"
    .Visible = True
    .ScrollArea = "a1:l1048576"
    introw1 = .[b1048576].End(3).Row
    If introw1 >= 3 Then .Range("b3:l" & introw1 & "").Delete
End With
With Sheets("商品信息")
    introw = .[b1048576].End(3).Row
    For i = 3 To introw
        If Not IsEmpty(.Cells(i, 10)) Then
            If .Cells(i, 10) >= .Cells(i, 12) Then
                报警数据 i, "低"
            End If
        End If
        If Not IsEmpty(.Cells(i, 11)) Then
            If .Cells(i, 11) <= .Cells(i, 12) Then
                报警数据 i, "高"
            End If
        End If
    Next i
End With
With Sheets("库存报警")
    introw1 = .[b1048576].End(3).Row
    .Range("b3:l" & introw1 & "").Borders.LineStyle = xlContinuous
    .Protect Password:="wyh"
End With
Application.ScreenUpdating = True
End Sub

Sub 报警数据(ByVal i As Integer, ByVal strbj As String)
Dim introw   As Integer
Dim j  As Integer
With Sheets("库存报警")
    introw = .[b1048576].End(3).Row + 1
    For j = 2 To 7
        .Cells(introw, j) = Sheets("商品信息").Cells(i, j)
    Next j
    .Cells(introw, 8) = Sheets("商品信息").Cells(i, 9)
    .Cells(introw, 9) = Sheets("商品信息").Cells(i, 10)
    .Cells(introw, 10) = Sheets("商品信息").Cells(i, 11)
    .Cells(introw, 11) = Sheets("商品信息").Cells(i, 12)
    .Cells(introw, 12) = strbj
End With
End Sub

jsgj2023

===============================part12应付账款管理==============================
Private Sub Worksheet_Activate()
Dim introw   As Integer
Dim introw1 As Integer
Dim i   As Integer
Application.ScreenUpdating = False
HideOption
With Sheets("应付账管理")
    .ScrollArea = "a1:e1048576"
    .Visible = True
    .Unprotect Password:="wyh"
    introw = .[b1048576].End(3).Row
    If introw >= 4 Then Range("b4:e" & introw & "").Delete
    introw1 = Sheets("供应商").[b1048576].End(3).Row
    For i = 3 To introw1
        .Cells(i + 1, 2) = Sheets("供应商").Cells(i, 2)
    Next i
    introw = Sheets("入库明细").[b1048576].End(3).Row
    With ActiveWorkbook.Names
        .Add Name:="YFZRKS", RefersToR1C1:="=入库明细!R3C3:R" & introw & "C11"
        .Add Name:="RK_1", RefersToR1C1:="=入库明细!R3C12:R" & introw & "C12"
        .Add Name:="RK_2", RefersToR1C1:="=入库明细!R3C13:R" & introw & "C13"
        .Add Name:="RK_3", RefersToR1C1:="=入库明细!R3C14:R" & introw & "C14"
    End With
    .Cells(4, 3).Formula = "=sumif(YFZRKS,B4,RK_1)"
    .Cells(4, 4).Formula = "=sumif(YFZRKS,B4,RK_2)"
    .Cells(4, 5).Formula = "=sumif(YFZRKS,B4,RK_3)"
    introw = .[b108576].End(3).Row
    Range("c4:e4").AutoFill Destination:=Range("c4:e" & introw & ""), Type:=xlFillDefault
    Range("b4:e" & introw & "").Borders.LineStyle = xlContinuous
    .Protect Password:="wyh"
End With
Application.ScreenUpdating = True
End Sub

jsgj2023

==================part13库存明细账========================

Dim introw1 As Integer
Dim introw2 As Integer
Dim strBh  As String
Dim introw3 As Integer

Private Sub cmdNext_Click()
introw1 = introw1 + 1
设置按钮状态
生成库存明细账
End Sub

Private Sub cmdPre_Click()
introw1 = introw1 + 1
设置按钮状态
生成库存明细账
End Sub


Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
HideOption
With Sheets("库存明细账")
    .ScrollArea = "a1:l1048576"
    .Visible = True
    .Unprotect Password:="wyh"
End With
introw1 = 3
introw2 = Sheets("商品信息").[a12]
If introw2 >= introw1 Then 生成库存明细账
设置按钮状态
Application.ScreenUpdating = True
End Sub
Sub 设置按钮状态()
If introw2 < 3 Then
    cmdPre.Enabled = False
    cmdNext.Enabled = False
ElseIf introw1 >= introw2 Then
    cmdPre.Enabled = True
    cmdNext.Enabled = False
ElseIf introw1 <= 3 Then
    cmdPre.Enabled = False
    cmdNext.Enabled = True
Else
    cmdPre.Enabled = True
    cmdNext.Enabled = True
End If
End Sub
Sub 生成库存明细账()
Application.ScreenUpdating = False
With Sheets("库存明细账")
    .Unprotect Password:="wyh"
    introw = .[b1048576].End(3).Row
    If introw >= 8 Then
        .Range(.Cells(8, 2), .Cells(introw, 12)).EntireRow.Delete
    End If
    introw3 = 8
    .Range("b9").Select
End With
With Sheets("库存明细账")
    strBh = Trim(Sheets("商品信息").Cells(introw1, 2))
    .Range("c4") = strBh
    .Range("e4") = Sheets("商品信息").Cells(introw1, 3)
    .Range("i4") = Sheets("商品信息").Cells(introw1, 4)
    .Range("k4") = Sheets("商品信息").Cells(introw1, 5)
    .Range("p4") = Sheets("商品信息").Cells(introw1, 6)
    .Range("q4") = Sheets("商品信息").Cells(introw1, 7)
    .Cells(introw3, 5) = .Range("p4")
    .Cells(introw3, 6) = .Range("q4")
    .Cells(introw3, 4) = "上期结存"
    .Cells(introw3, 11) = CCur(Sheets("商品信息").Cells(introw1, 8))
    .Cells(introw3, 12) = .Cells(introw3, 6) * .Cells(introw3, 11)
    introw3 = introw3 + 1
End With
读入入库数据
读入出库数据
计算结存数据
Application.ScreenUpdating = True
End Sub

Sub 读入入库数据()
Dim x  As Integer
Dim y As Integer
With Sheets("库存明细账")
    x = 3
    Do While Not (IsEmpty(Sheets("入库明细").Cells(x, 4)))
        If Trim(Sheets("入库明细").Cells(x, 4)) = strBh Then
            If IsEmpty(Sheets("入库明细").Cells(x, 1)) Then
                y = Sheets("入库明细").Cells(x, 1).End(3).Row
            Else
                y = x
            End If
            .Cells(introw3, 2).NumberFormatLocal = "yyyy-mm-dd"
            .Cells(introw3, 2) = Sheets("入库明细").Cells(y, 2)
            .Cells(introw3, 3) = Sheets("入库明细").Cells(y, 1)
            .Cells(introw3, 4) = "从" & Sheets("入库明细").Cells(y, 3) & "购入"
            .Cells(introw3, 5) = .Range("p4")
            .Cells(introw3, 6) = .Range("q4")
            .Cells(introw3, 7) = Sheets("入库明细").Cells(x, 9)
            .Cells(introw3, 8) = Sheets("入库明细").Cells(x, 10)
            introw3 = introw3 + 1
        End If
        x = x + 1
    Loop
End With
End Sub
Sub 读入出库数据()
Dim x As Integer
Dim y   As Integer
With Sheets("库存明细账")
    x = 3
    Do While Not (IsEmpty(Sheets("出库明细").Cells(x, 4)))
        If Trim(Sheets("出库明细").Cells(x, 4)) = strBh Then
            If IsEmpty(Sheets("出库明细").Cells(x, 1)) Then
                y = Sheets("出库明细").Cells(x, 1).End(3).Row
            Else
                y = x
            End If
            .Cells(introw3, 2).NumberFormatLocal = "yyyy-mm-dd"
            .Cells(introw3, 2) = Sheets("出库明细").Cells(y, 2)
            .Cells(introw3, 3) = Sheets("出库明细").Cells(y, 1)
            .Cells(introw3, 4) = "发货到:" & Sheets("出库明细").Cells(y, 3)
            .Cells(introw3, 5) = .Range("p4")
            .Cells(introw3, 6) = .Range("q4")
            .Cells(introw3, 9) = Sheets("出库明细").Cells(x, 9)
            .Cells(introw3, 10) = Sheets("出库明细").Cells(x, 10)
            introw3 = introw3 + 1
        End If
        x = x + 1
    Loop
End With
End Sub

Sub 计算结存数据()
Dim x   As Integer
Dim rantemp As Range
With Sheets("库存明细账")
    .Range("b9:l" & introw3).Sort key1:=.Range("b9"), order1:=xlAscending, _
    Header:=xlGuess, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    SortMethod:=xlPinYin, dataoption1:=xlSortNormal
    For x = 9 To introw3 - 1
        .Cells(x, 11) = .Cells(x - 1, 11) + .Cells(x, 7) - .Cells(x, 9)
        .Cells(x, 12) = .Cells(x, 11) * .Cells(x, 6)
    Next x
    .Cells(introw3, 2) = "合计"
    .Cells(introw3, 7) = "=sum(R[" & 7 - x & "]C:R[-1]C)"
    .Cells(introw3, 8).FormulaR1C1 = "=SUM(R[" & 7 - x & "]C:R[-1]C)"
    .Cells(introw3, 9) = "=SUM(R[" & 7 - x & "]C:R[-1]C)"
    .Cells(introws, 10).FormulaR1C1 = "=SUM(R[" & 7 - x & "]C:R[-1]C)"
    .Range(.Cells(8, 2), .Cells(introw3, 12)).Borders.LineStyle = xlContinuous
    .Range("b8").Select
End With
Sheets("库存明细账").Protect Password:="wyh"
End Sub

jsgj2023

========================part14模块1===================
Sub 主界面()
Dim sh As Worksheet
Application.ScreenUpdating = False
Sheets("主界面").Activate
ActiveWindow.ScrollColumn = 3
Sheets("主界面").ScrollArea = "d1"
For Each sh In Sheets
    If sh.Name <> "主界面" Then
        sh.Protect Password:="wyh"
        sh.Visible = False
    End If
Next sh
Application.ScreenUpdating = True
End Sub

Sub showSPXX(ByVal control As IRibbonControl)
Sheets("商品信息").Activate
Sheets("商品信息").Visible = True
End Sub

Sub showBMXX(ByVal control As IRibbonControl)
Sheets("部门").Activate
Sheets("部门").Visible = True
End Sub

Sub showGYSXX(ByVal control As IRibbonControl)
Sheets("供应商").Activate
Sheets("供应商").Visible = True
End Sub

Sub showRKD(ByVal control As IRibbonControl)
Sheets("入库单").Activate
Sheets("入库单").Visible = True
End Sub

Sub showRKMX(ByVal control As IRibbonControl)
Sheets("入库明细").Activate
Sheets("入库明细").Visible = True
End Sub

Sub showCKD(ByVal control As IRibbonControl)
Sheets("出库单").Activate
Sheets("出库单").viseble = True
End Sub

Sub showCKMX(ByVal control As IRibbonControl)
Sheets("出库明细").Activate
shets("出库明细").Visible = True
End Sub

Sub showKCXX(ByVal control As IRibbonControl)
Sheets("库存汇总").Activate
Sheets("库存汇总").Visible = True
End Sub

Sub showKCMXZ(ByVal control As IRibbonControl)
Sheets("库存明细账").Activate
Sheets("库存明细账").Visible = True
End Sub

Sub showYFZK(ByVal control As IRibbonControl)
Sheets("应付账管理").Activate
Sheets("应付账管理").Visible = True
End Sub

Sub showPDB(ByVal control As IRibbonControl)
Sheets("盘点表").Activate
Sheets("盘点表").Visible = True
End Sub

Sub showKCBJ(ByVal control As IRibbonControl)
Sheets("库存报警").Activate
Sheets("库存报警").Visible = True
End Sub

Sub hideoption()
With ActiveWindow
    .DisplayHeadings = False
    .DisplayGridlines = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
    .DisplayRuler = False
    .DisplayWorkbookTabs = False
End With
End Sub

Function capsMoney(curMoney As Currency) As String
Dim curMoney1   As Long
Dim i1 As Long
Dim i2 As Integer
Dim i3 As Integer
Dim s1 As String
Dim s2 As String
Dim s3 As String
curMoney1 = Round(curMoney * 100)
i1 = Int(curMoney1 / 100)
i2 = Int(curMoney1 / 10) - i1 * 10
i3 = curMoney1 - i1 * 100 - i2 * 10
s1 = Application.WorksheetFunction.Text(i1, "[dbnum2]")
s2 = Application.WorksheetFunction.Text(i2, "[dbnum2]")
s3 = Application.WorksheetFunction.Text(i3, "[dbnum2]")
s1 = s1 & "元"
If i3 <> 0 And i2 <> 0 Then
    s1 = s1 & s2 & "角" & s3 & "分"
    If i1 = 0 Then
        s1 = s2 & "角" & s3 & "分"
    End If
End If
If i3 = 0 And i2 <> 0 Then
    s1 = s1 & s2 & "角整"
    If i1 = 0 Then
        s1 = s2 & "角整"
    End If
End If
If i3 <> 0 And i2 = 0 Then
    s1 = s1 & s2 & s3 & "分"
    If i1 = 0 Then
        s1 = s3 & "分"
    End If
End If
If Right(s1, 1) = "元" Then s1 = s1 & "整"
capsMoney = s1
End Function

Sub test()
Dim sh As Worksheet
For Each sh In Sheets
    sh.Visible = True
Next
End Sub