二個惡魔買一對鞋 , 郤沒我的

二個惡魔買一對鞋 , 郤沒我的 , 還要我出錢
不過鞋還是閃閃的那一種

我的作品 請大家宣傳喔 ONENOTE

有需要的朋友可以參考一下喔
作者：楊玉文
分類：電腦與網路／應用軟體 叢書系列：OFFICE類
出版社：碁峰 出版日期：2010/7/6
ISBN：9789861819822 書籍編號：kk0271011

EXCEL VBA 身份證檢查

1 工具 / 巨集 / VB編輯程式
2 對工作表SHEET1 按左鍵二下
3 於右側視窗輸入
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
Dim T0, A0, A1, A2, A3, A4, A5, A6, A7, A8, CK, SUM1 As Integer
x = Left(Target.Address, 2)
If x = "$A" Then
If (Len(Target.Value) <> 10) Then
Target.Value = "重新輸入"

Else



T0 = Asc(UCase(Left(Target.Value, 1)))
A1 = (((Val(Right(Target.Value, 9)) \ 100000000) Mod 10) * 8) Mod 10
A2 = (((Val(Right(Target.Value, 8)) \ 10000000) Mod 10) * 7) Mod 10
A3 = (((Val(Right(Target.Value, 7)) \ 1000000) Mod 10) * 6) Mod 10
A4 = (((Val(Right(Target.Value, 6)) \ 100000) Mod 10) * 5) Mod 10
A5 = (((Val(Right(Target.Value, 5)) \ 10000) Mod 10) * 4) Mod 10
A6 = (((Val(Right(Target.Value, 4)) \ 1000) Mod 10) * 3) Mod 10
A7 = (((Val(Right(Target.Value, 3)) \ 100) Mod 10) * 2) Mod 10
A8 = (((Val(Right(Target.Value, 2)) \ 10) Mod 10) * 1) Mod 10
CK = Val(Right(Target.Value, 1))
Select Case T0
Case 65, 77, 87
A0 = 0
Case 75, 76, 89
A0 = 1
Case 74, 86, 88
A0 = 2
Case 72, 85
A0 = 3
Case 84, 71
A0 = 4
Case 70, 83
A0 = 5
Case 69, 82
A0 = 6
Case 68, 81, 79
A0 = 7
Case 67, 80, 73
A0 = 8
Case 66, 78, 90
A0 = 9
Case Else
' ActiveCell.Formula = "重新輸入"
Target.Value = "重新輸入"
End Select
SUM1 = 9 - ((A0 + A1 + A2 + A3 + A4 + A5 + A6 + A7 + A8) Mod 10)
If CK <> SUM1 Then

Target.Value = "重新輸入"
End If

End If


End If
End Sub

4 於A欄輸入身份字號 , 就知到答案了

今天到家已是12:10分

今天到家已是12:10 11:00還在新竹上課 網路碰到不能追的美女
[花一朵 ] 政大高材生喔 也是高身材喔 真是萬分高興 ,
但是沒碰到仙丹的朋友 [政大大美女 也是追不到的那一種] 真是萬分
...
回到家妹咕睡了 看了阿咪的照片第三天游泳 與您分享

妹咕第二天泳照

妹咕變高了

妹咕學游泳

今天妹咕學游泳 , 阿咪回報在岸上流汗全溼 , 妹咕在水中也是全濕真是太有趣了

大家快去參加喔

『老闆最”照”職場最A咖 拿iPhone』
活動方式: 邀請有拿過證照的學員來參賽(不限巨匠)，只要分享拿證照的心得，就OK。最高票的人氣王就可以拿iPhone。活動相當簡單
活動網址: http://www.pcschool.com.tw/activity/99/9906_a/index.aspx
活動時間~8/16

新相機 照妹咕

妹咕是相機中的第一個MODEL

妹咕金乖 , 幫忙掃地

妹咕掃地一邊掃一邊唱歌請大家猜她唱的是什麼歌

儲存格設計清單

Private Sub Worksheet_Change(ByVal Target As Range)

x = Left(Target.Address, 2)
If x = "$A" Then
Select Case Target.Value
Case 2
Target.Value = "台北"
Case 3
Target.Value = "桃園"
Case 4
Target.Value = "台中"
Case 5
Target.Value = "嘉義"
Case 6
Target.Value = "台東"
Case 7
Target.Value = "高雄"

End Select


End If

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

x = Left(Target.Address, 2)
If x = "$C" Then
Select Case Target.Value
Case 1
Target.Value = ActiveCell.Offset(0, -1).Value + ActiveCell.Offset(0, -2).Value

Case 2
Target.Value = (ActiveCell.Offset(0, -1).Value + ActiveCell.Offset(0, -2).Value) / 2
Case 3
Target.Value = ActiveCell.Offset(0, -1).Value - ActiveCell.Offset(0, -2).Value


End Select


End If


End Sub




Private Sub Worksheet_Activate()
Range("b6").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
X = ActiveCell.Value2

ActiveCell.Value = X




End Sub

Private Sub OK_Click() ' 表單元件


ActiveCell.Offset(0, 0).Value = num1.Value
ActiveCell.Offset(0, 1).Value = num2.Value
ActiveCell.Offset(0, 2).Value = num3.Value
ActiveCell.Offset(0, 3).Value = num4.Value
ActiveCell.Offset(1, 0).Select
num1.Value = Empty
num2.Value = Empty
num3.Value = Empty
num4.Value = Empty
num1.SetFocus

End Sub

中華工程 - 新增工作表

Sub 方法一()
Dim mySht As Worksheet
Dim x, y
x = InputBox("請輸入增加工作表的數量", "增加工作表")
For y = 1 To x Step 1
Set mySht = Worksheets.Add(After:=Sheets(Sheets.Count))
With mySht
.Name = y '設定表名
End With
Next y
Set mySht = Nothing '物件的釋放
End Sub

Sub 方法二()
Dim x, y
x = InputBox("請輸入增加工作表的數量", "增加工作表")
With Worksheets
.Add Count:=x '指定張數來新增

End With
End Sub

匯入文件

Public i, j, x, y

Sub 新工作表()
'
' 新工作表 Macro
' gmadmin 在 2010/6/11 錄製的巨集
'

Sheets(1).Select
Sheets.Add
End Sub
Sub 複製()


j = y


For i = 2 To j + 1



Sheets(i).Select


If i = 2 Then
Range("A1").Select
Else
Range("A2").Select
End If

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

Next




End Sub


Public Sub 整合()
新工作表
複製
Range("A1").Select
End Sub
Sub 匯入文字()

y = InputBox("請輸入檔案數量")

For x = 1 To y
新工作表


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & x & ".txt", Destination:=Range( _
"A1"))
.Name = "1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Next
整合

End Sub

複製 - 中華工程

Sub 新工作表()
'
' 新工作表 Macro
' gmadmin 在 2010/6/11 錄製的巨集
'

Sheets(1).Select
Sheets.Add
End Sub
Sub 複製()

Dim i, j As Integer

j = InputBox("請輸入工作表張數")


For i = 2 To j + 1



Sheets(i).Select


If i = 2 Then
Range("A1").Select
Else
Range("A2").Select
End If

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

Next




End Sub


Public Sub 整合()
新工作表
複製
Range("A1").Select
End Sub

VBA 中華工程

Sub 流水號()

X = ActiveCell.Value
y = InputBox("請輸入結束值")


If X = Empty Then
ActiveCell.Value = 1


Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=y, Trend:=False

Else
If X <= Int(y) Then

Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=y + X, Trend:=False

Else


End If

End If


End Sub

Public Function 小計(折扣, 單價, 優惠, 數量)
If 數量 > 5 And 優惠 = "Y" And 單價 > 400 Then
小計 = 單價 * 數量 * (1 - 折扣)
Else

小計 = 單價 * 數量

End If


End Function


Public Function 評語(身高, 體重, 性別)

標準 = 身高 * 身高 * 22 / 10000

If 性別 = 1 Then
標準 = 標準 * 1.1
Else
標準 = 標準 * 0.9
End If

上限 = 標準 * 1.1
下限 = 標準 * (1 - 0.1)


If 體重 > 上限 Then

評語 = "太重"

Else

If 體重 < 下限 Then

評語 = "太輕"

Else

評語 = "太正常"
End If
End If



End Function

東吳出美女

都是大美女