1,页眉用指定单元格内容
Sub 页眉()
'页眉用指定单元格内容
' 2007-4-10
'
ActiveSheet.PageSetup.PrintArea = "$A$1:$E$30"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ActiveSheet.Cells(1, 3).Value ‘指定单元格 C1
'.CenterHeader = ThisWorkbook.FullName ‘打印工作簿全名
'.RightHeader = ""
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub
2,转存到另一工作簿(指定路径、文件名)
Sub zclgzb0418()
'转存到另一工作簿
‘http://club.excelhome.net/dispbbs.asp?boardID=2&ID=234461&page=1&px=0
Dim Mynm$
On Error Resume Next
Application.ScreenUpdating = False
[a3].CurrentRegion.Copy
Mynm = ThisWorkbook.Path & "\" & [a3].Value
Workbooks.Add
ActiveSheet.Paste
[a1].Activate
ActiveWorkbook.SaveAs Filename:=Mynm
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
3,数字转美元和沙特里亚尔(阿拉伯数字转英文写法)
Public ywGW, ywSW, ywSwGw, swgw, i%, le1%, Ws()
Public Myarr(), aa, ywJFS, ywGEW, ywBW, ywQW, ywSWW, ywMIL, ywWWW
Sub mydx0419()
‘数字转美元里亚尔 0506.xls
‘http://club.excelhome.net/dispbbs.asp?BoardID=3&ID=236041&replyID=&skin=0
Dim Do2$, do2dxy$, Do2dxygw$
ywWWW = "": ywMIL = "": ywSWW = "": ywQW = "": ywBW = "": ywGEW = "": ywJFS =
""
Do2 = Replace(Application.Text(Round(ActiveCell + 0.00000001, 2), "#,##0.00"), ".", "")
'MsgBox Do2
Do2 = Replace(Do2, ",", "")
le1 = Len(Do2)
ReDim Myarr(1 To le1)
ReDim Ws(1 To le1)
j = le1
For i = 1 To le1
Myarr(i) = Mid(Do2, i, 1)
Ws(j) = Myarr(i)
j = j - 1
Next i
For i = 2 To le1
If i = 3 And i <> le1 Then GoTo 1000
If i = 2 Or i = 4 Or i = 7 Or i = 10 Then GoTo 200
If i = 5 Or i = 8 Or i = 11 Then GoTo 500
If i = le1 Then
Call weisu(Ws(i))
If i = 3 Then ywGEW = ywGW: GoTo 2000
If i = 6 Then ywQW = ywGW & " THOUSAND": GoTo 2000
End If
If i = 9 And i = le1 And Ws(i) <> 0 Then
Call weisu(Ws(i))
ywMIL = ywGW & " MILLION": GoTo 2000
End If
200: If Ws(i) = 0 Then
If Ws(i - 1) <> 0 Then
Call weisu(Ws(i - 1))
If i = 2 And Ws(i - 1) <> 1 Then
ywJFS = " AND CENTS" & ywGW: GoTo 1000
ElseIf i = 2 And Ws(1) = 1 And le1 > 3 Then ywJFS = " AND CENT ONE": GoTo 1000
ElseIf i = 2 And Ws(1) = 1 And le1 < 4 Then ywJFS = " CENT ONE": GoTo 1000
End If
If i = 4 Then ywGEW = ywGW: GoTo 1000
If i = 7 Then ywQW = ywGW & " THOUSAND": GoTo 1000
If i = 10 Then ywMIL = ywGW & " MILLION": GoTo 1000
ElseIf i = 2 Then ywJFS = ""
ElseIf i = 4 Then ywGEW = ""
ElseIf i = 7 Then ywQW = ""
ElseIf i = 10 Then ywMIL = ""
End If
Else
Call sw(Ws(i))
If i = 2 Then ywJFS = " AND CENTS" & swgw: GoTo 1000 英文角分
If i = 4 Then ywGEW = swgw: GoTo 1000 '英文个位
If i = 7 Then ywQW = swgw & " THOUSAND": GoTo 1000 '英文千位
If i = 10 Then ywMIL = swgw & " MILLION": GoTo 1000 '英文百万位
End If
500: If i = 5 Or i = 8 Or i = 11 Then
If Ws(i) <> 0 Then
Call weisu(Ws(i))
If i = 5 Then ywBW = ywGW & " HUNDRED": GoTo 1000
If i = 8 And ywQW = "" Then ywSWW = ywGW & " HUNDRED THOUSAND": GoTo
1000
If i = 8 And ywQW <> 0 Then ywSWW = ywGW & " HUNDRED": GoTo 1000
If i = 11 And ywMIL = "" Then ywWWW = ywGW & " HUNDRED MILLION": GoTo
1000
If i = 11 And ywMIL <> "" Then ywWWW = ywGW & " HUNDRED": GoTo 1000
Else
If i = 8 Then ywSWW = ""
If i = 11 Then ywWWW = ""
If i = 5 Then ywBW = "": GoTo 1000
End If
End If
1000: Next i
2000:
If Ws(3) = 1 And le1 < 4 Then Do2 = "UNITED STATES" & ywGEW & " DOLLAR" &
ywJFS & " ONLY": GoTo 2100
If Ws(3) = 0 And le1 < 4 Then Do2 = "UNITED STATES" & " CENTS" & swgw & "
ONLY": GoTo 2100
Do2 = "UNITED STATES" & ywWWW & ywMIL & ywSWW & ywQW & ywBW &
ywGEW & " DOLLARS" & ywJFS & " ONLY"
2100:
ActiveCell.Offset(, 1).Value = Do2
End Sub
Sub mydx0506()
'美元
Dim Do2$, do2dxy$, Do2dxygw$
ywWWW = "": ywMIL = "": ywSWW = "": ywQW = "": ywBW = "": ywGEW = "": ywJFS =
"": swgw = ""
If ActiveCell = "" Or ActiveCell.Value = 0 Then MsgBox " 请重新选择有美元数字的单元
格!": Exit Sub
Do2 = Replace(Application.Text(Round(ActiveCell + 0.00000001, 2), "#,##0.00"), ".", "")
'MsgBox Do2
Do2 = Replace(Do2, ",", "")
le1 = Len(Do2)
ReDim Myarr(1 To le1)
ReDim Ws(1 To le1)
j = le1
For i = 1 To le1
Myarr(i) = Mid(Do2, i, 1)
Ws(j) = Myarr(i)
j = j - 1
Next i
For i = 2 To le1
If i = 3 And i <> le1 Then GoTo 1000
If i = 2 Or i = 4 Or i = 7 Or i = 10 Then GoTo 200
If i = 5 Or i = 8 Or i = 11 Then GoTo 500
If i = le1 Then
Call weisu(Ws(i))
If i = 3 Then ywGEW = ywGW: GoTo 2000
If i = 6 Then ywQW = ywGW & " THOUSAND": GoTo 2000
End If
If i = 9 And i = le1 And Ws(i) <> 0 Then
Call weisu(Ws(i))
ywMIL = ywGW & " MILLION": GoTo 2000
End If
200: If Ws(i) = 0 Then
If Ws(i - 1) <> 0 Then
Call weisu(Ws(i - 1))
If i = 2 And Ws(i - 1) <> 1 Then
ywJFS = " CENTS" & ywGW: GoTo 1000
ElseIf i = 2 And Ws(1) = 1 And le1 > 3 Then ywJFS = " CENT ONE": GoTo 1000
ElseIf i = 2 And Ws(1) = 1 And le1 < 4 Then
ywJFS = " CENT ONE": GoTo 1000
End If
If i = 4 Then ywGEW = ywGW: GoTo 1000
If i = 7 Then ywQW = ywGW & " THOUSAND": GoTo 1000
If i = 10 Then ywMIL = ywGW & " MILLION": GoTo 1000
ElseIf i = 2 Then ywJFS = ""
ElseIf i = 4 Then ywGEW = ""
ElseIf i = 7 Then ywQW = ""
ElseIf i = 10 Then ywMIL = ""
End If
Else
Call sw(Ws(i))
If i = 2 Then ywJFS = " CENTS" & swgw: GoTo 1000 '英文角分数
If i = 4 Then ywGEW = swgw: GoTo 1000 '英文十位个位
If i = 7 Then ywQW = swgw & " THOUSAND": GoTo 1000 '英文千位
If i = 10 Then ywMIL = swgw & " MILLION": GoTo 1000 '英文百万位
End If
500: If i = 5 Or i = 8 Or i = 11 Then
If Ws(i) <> 0 Then
Call weisu(Ws(i))
If i = 5 Then ywBW = ywGW & " HUNDRED": GoTo 1000
If i = 8 And ywQW = "" Then ywSWW = ywGW & " HUNDRED THOUSAND": GoTo
1000
If i = 8 And ywQW <> 0 Then ywSWW = ywGW & " HUNDRED": GoTo 1000
If i = 11 And ywMIL = "" Then ywWWW = ywGW & " HUNDRED MILLION": GoTo
1000
If i = 11 And ywMIL <> "" Then ywWWW = ywGW & " HUNDRED": GoTo 1000
Else
If i = 8 Then ywSWW = ""
If i = 11 Then ywWWW = ""
If i = 5 Then ywBW = "": GoTo 1000
End If
End If
1000: Next i
2000:
If Ws(3) = 1 And le1 < 4 And ywJFS <> "" Then Do2 = "UNITED STATES" & ywGEW & "
DOLLAR AND" & ywJFS & " ONLY": GoTo 2100
If Ws(3) = 1 And le1 < 4 And ywJFS = "" Then Do2 = "UNITED STATES" & ywGEW & "
DOLLAR ONLY": GoTo 2100
If Ws(3) = 0 And Ws(2) <> 0 And le1 < 4 Then Do2 = "UNITED STATES" & " CENTS" &
swgw & " ONLY": GoTo 2100
If Ws(3) = 0 And le1 < 4 Then Do2 = "UNITED STATES" & ywJFS & " ONLY": GoTo
2100