2009年1月31日星期六

來自一位美女的信 - 大家要注意

交通新罰本月20 日開始,很重要! 有車沒車的人都要看本月 20 日開始
紅燈右轉$ 5 4 0 0 元
三 次馬上吊銷駕照 ...........
請看以下重罰項目
有 車 沒 車 的 人 都 要 看 本 月 2 0 日 開 始 ..... 再 提 醒 各 位 ! 注 意 ! !
殺 掉 這 封 信 你 將 會 後 悔 . ( 交通警察準備向全國違規人 . 徵收年終獎金 )
本月 2 0 日起,馬上開始 罰 ㄌ . . . 再次提醒各位注意 ! !

不管你是 騎機車 或者是 開汽車 的 ---請注意 !!

全國 ( Taiwan ) 將實施紅燈越線處罰條例 , 凡是在 等待紅燈時

超出白? 漈! T止越線 者馬上處以 900 元的罰金。

還有紅燈右轉 --- $ 5 4 0 0 元

( 這是目前交通警察的重點工作之一 )
注 意 喔 ! ! !
本月 2 0 日起, 走路未靠右邊 ,馬上罰台幣 600 元。

沒有車的人,通知一下有車族吧!趕快通知你的親朋好友吧!
最好印一張,能 提醒自己。

1 . 闖紅燈 由 1 8 0 0 - 3 6 0 0 元, 調為 3 6 0 0 - 7 2 0 0 元 !!!!

2 . 超速 由 1 2 0 0 - 2 4 0 0 元,

調為 6 0 0 0 ! + 每超 速 1 公里加罰 1 0 0 元 ! !!!! !
若限速 6 0 ,你開 8 0 ,則需付 6 0 0 0 + ( 8 0 - 6 0 ) * 1 0 0 元。
3 . 駕駛一般道路, 未繫安全帶! ,調為 1 5 0 0 元。
4 6歲 以下兒童,單獨留在車內 ,由 0 調為 3 0 0 0 元 。

自求多福 ㄌ !!

非常重要!小心 0809 一分鐘費用高 2425 元!
最近興起了一種新的電話詐騙手法,要提醒各位觀眾特別注。如果你有收到
留言或電子郵件,要你回電話到區域號碼為 0809 的電話,

要提醒你可千萬不要回電,

如果一回電, 一分鐘馬上會被收取達 2425 元的電話費。
AT&T電話公司表示,
區域號碼是巴哈馬等英屬維京群島的付費電話 ,

由於0809電話不在政府管轄範圍內,

所以一打就會馬上收費,

不會先有警告。

另外,全美詐騙資訊中心也證實,

這項電話詐騙,

可在短時間奪走受害者數千甚至

數萬元之多,民眾要格外留心。
和 0800 的不同,要注意哦!
現在的免付費電話開頭是 0800 才對,

千萬不要以為前面有 080 請千萬注意:之前有人接到一通自稱是郵局的電話,說有掛號郵件被退!
寄件者為台北市社會局,內有現金支票!

需打 0809021091 轉分機 04 或 ! 05 由台北市社會局人員確認。
警察局已確認這是詐騙電話;高額電話費,目前市刑大已在追查。請務必幫忙轉寄。

0800 是免付費電話 0809是高額電話費號碼 080*電話要注意

2009年1月25日星期日

休假無處去 - vba2

以上是第二個檔案vba
Public x, y, sname, cname
Sub 傳工作表()
sname = "A簽到表"
cname = "A聯絡狀況表"
End Sub



Sub 同一天()
If Range("J8").Value = True Then
    Range("J6").Value = Range("J4").Value
Else
Range("J6").Value = Empty
End If
End Sub

   
Sub 選地區()

 Select Case Range("F2").Value
  Case "三峽-插角國小", "臺北縣政府-資訊中心"
       Range("x1").Value = "201"
       Range("x2").Value = "202"
       Range("x3").Value = "203"
       Range("x4:x50").Value = Empty
 
  Case "板橋-巨匠中山"
       Range("x1").Formula = "501"
       Range("x2").Formula = "502"
       Range("x3").Formula = "504"
       Range("x4").Formula = "505"
       Range("x5:x50").Value = Empty
       
  Case "三重-巨匠"
       Range("x1").Formula = "801"
       Range("x2").Formula = "802"
       Range("x3").Formula = "804"
       Range("x4:x50").Value = Empty
       
  Case "永和-巨匠", "新莊-巨匠中正", "新店-巨匠"
       Range("x1").Formula = "201"
       Range("x2").Formula = "202"
       Range("x3").Formula = "203"
       Range("x4:x50").Value = Empty
       
  Case "淡水-巨匠", "樹林-巨匠", "蘆洲-巨匠", "板橋-巨匠文化"
       Range("x1").Formula = "101"
       Range("x2").Formula = "202"
       Range("x3").Formula = "103"
       Range("x4:x50").Value = Empty
       
  Case "中和-巨匠"
       Range("x1").Formula = "301"
       Range("x2").Formula = "402"
       Range("x3").Formula = "303"
       Range("x4:x50").Value = Empty
  Case "新莊-巨匠中港"
  Case "三芝-三芝國小"
  Case "八里-米倉國小"
  Case "土城-中正國中"
  Case "烏來-烏來國小"
  Case "坪林-坪林國小"
  Case "貢寮-福連國小"
  Case "雙溪-雙溪國小"
  Case "平溪-平溪國中"
  Case "瑞芳-瑞芳國小"
  Case "深沆-鄉立圖書館"
  Case "汐止-金龍國小"
  Case "金山-金美國小"
  Case "萬里-萬里國小"
  Case "石碇-鄉公所"
  Case "石門-石門國中"
  Case "五股-德音國小"
  Case "林口-南勢國小"
  Case "泰山-泰山國小"
  Case "鶯歌-二橋國小"
 End Select
   
  
End Sub
Sub 新增一筆()
Dim x, y, v0, v1, v2, v3, v4, v5, v6, v7
傳工作表
x = Range("e17").Value
If Int(x) < 32 Then

    y = x + 9
    v0 = "b" & y
    v0 = Sheets(sname).Range(v0).Value
   If v0 <> Empty Then
      MsgBox "無法新增"
   Else
       v0 = "b" & y
      v1 = "f" & y
      v2 = "i" & y
      v3 = "l" & y
      v4 = "n" & y
      v5 = "q" & y
      v6 = "r" & y

       Sheets(sname).Range(v0).Value = Range("g16").Value
       Sheets(sname).Range(v1).Value = Range("g18").Value
       Sheets(sname).Range(v2).Value = Range("g20").Value
       Sheets(sname).Range(v3).Value = Range("k16").Value
       Sheets(sname).Range(v4).Value = Range("k17").Value
       Sheets(sname).Range(v5).Value = Range("i16").Value
       Sheets(sname).Range(v6).Value = Range("i18").Value


        Range("E17").Value = x + 1
        Range("g16").Value = Empty
        Range("g18").Value = Empty
        Range("g20").Value = Empty
        Range("k16").Value = Empty
        Range("k17").Value = Empty
        Range("i16").Value = Empty
        Range("i18").Value = Empty
     End If
 Else
     MsgBox "無法新增"
 End If
End Sub
Sub 第一筆()

    y = 10

   傳值
    
    
End Sub
Sub 下一筆()

x = Range("e17").Value
Select Case Int(x)
Case 1
     y = 11
Case 32
     y = 41
Case Else
    y = x + 10
     
End Select
傳值
    
End Sub
Sub 傳值()
Dim v0, v1, v2, v3, v4, v5, v6, v7
傳工作表

v0 = "b" & y
v1 = "f" & y
v2 = "i" & y
v3 = "l" & y
v4 = "n" & y
v5 = "q" & y
v6 = "r" & y
v7 = "a" & y




v0 = Sheets(sname).Range(v0).Value
v1 = Sheets(sname).Range(v1).Value
v2 = Sheets(sname).Range(v2).Value
v3 = Sheets(sname).Range(v3).Value
v4 = Sheets(sname).Range(v4).Value
v5 = Sheets(sname).Range(v5).Value
v6 = Sheets(sname).Range(v6).Value
v7 = Sheets(sname).Range(v7).Value

Range("e17").Value = v7
Range("g16").Value = v0
Range("g18").Value = v1
Range("g20").Value = v2
Range("k16").Value = v3
Range("k17").Value = v4
Range("i16").Value = v5
Range("i18").Value = v6
   
End Sub
Sub 資料()
Dim v0, v1, v2, v3, v4, v5, v6, v7

傳工作表
      v0 = "b" & y
      v1 = "f" & y
      v2 = "i" & y
      v3 = "l" & y
      v4 = "n" & y
      v5 = "q" & y
      v6 = "r" & y

       Sheets(sname).Range(v0).Value = Range("g16").Value
       Sheets(sname).Range(v1).Value = Range("g18").Value
       Sheets(sname).Range(v2).Value = Range("g20").Value
       Sheets(sname).Range(v3).Value = Range("k16").Value
       Sheets(sname).Range(v4).Value = Range("k17").Value
       Sheets(sname).Range(v5).Value = Range("i16").Value
       Sheets(sname).Range(v6).Value = Range("i18").Value

End Sub
Sub 修改()
   x = Range("e17").Value
   y = x + 9
   資料
   MsgBox "修改成功"
 
End Sub
Sub 刪除()
Dim yes, x, v0, v1, v2, v3, v4, v5, v6, v7

   
傳工作表
   yes = MsgBox("您確定要刪除這一筆", vbYesNo)
   If yes = 6 Then
     x = Range("e17").Value
     y = x + 9
      v0 = "b" & y
      v1 = "f" & y
      v2 = "i" & y
      v3 = "l" & y
      v4 = "n" & y
      v5 = "q" & y
      v6 = "r" & y

       Sheets(sname).Range(v0).Value = Empty
       Sheets(sname).Range(v1).Value = Empty
       Sheets(sname).Range(v2).Value = Empty
       Sheets(sname).Range(v3).Value = Empty
       Sheets(sname).Range(v4).Value = Empty
       Sheets(sname).Range(v5).Value = Empty
       Sheets(sname).Range(v6).Value = Empty
      
      
       下一筆
   End If
  
   
End Sub
Sub 上一筆()
x = Range("e17").Value
Select Case Int(x)
Case 1
     y = 10
Case 32
     y = 32
Case Else
    y = x + 8
     
End Select
傳值
    
End Sub
Sub 連絡()
傳工作表
x = Range("e17").Value
v = "M" & x + 9
If Sheets(cname).Range(v).Value = Empty Then
x0 = InputBox("尚未有資料 , 請輸入連絡狀況")
Sheets(cname).Range(v).Value = x0
Else
MsgBox "己有連絡 ," & Sheets(cname).Range(v).Value

End If

    
End Sub
Sub 修改連絡()
傳工作表
x = Range("e17").Value
v = "M" & x + 9
x0 = InputBox("請輸入修正連絡內容", "巨匠電腦", Sheets(cname).Range(v).Value)
Sheets(cname).Range(v).Value = x0
MsgBox "修正成功"

End Sub
Sub 基本()
Dim v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11
傳工作表
v1 = Range("f2").Value
v2 = Range("f4").Value
v3 = Range("f6").Value
v4 = Range("f8").Value
v5 = Range("f10").Value
v6 = Range("f12").Value
v7 = Range("j4").Value
v8 = Range("j6").Value
v9 = Range("j10").Value
v10 = Range("j12").Value
v11 = Range("f13").Value



    
  Sheets(sname).Range("e4").Value = v1
  Sheets(sname).Range("e5").Value = v2
  Sheets(sname).Range("e7").Value = v3
  Sheets(sname).Range("m7").Value = v4
  Sheets(sname).Range("m4").Value = v5
  Sheets(sname).Range("m5").Value = v6
  Sheets(sname).Range("e6").Value = v7
  Sheets(sname).Range("i6").Value = v8
  Sheets(sname).Range("q4").Value = v9
  Sheets(sname).Range("m6").Value = v10
   Sheets(sname).Range("e55").Value = v11
  
  Sheets(cname).Range("e4").Value = v1
  Sheets(cname).Range("e5").Value = v2
  Sheets(cname).Range("e7").Value = v3
  Sheets(cname).Range("o7").Value = v4
  Sheets(cname).Range("o4").Value = v5
  Sheets(cname).Range("o5").Value = v6
  Sheets(cname).Range("e6").Value = v7
  Sheets(cname).Range("j6").Value = v8
  Sheets(cname).Range("t4").Value = v9
  Sheets(cname).Range("o6").Value = v10
  
End Sub

Sub 簽到()

    Sheets("簽到畫面").Select
    Range("A1").Select
End Sub
Sub 啟用()
 Sheets("啟用畫面").Select
    Range("A1").Select
   
End Sub
Sub 問卷調查()

    Sheets("滿意度調查表").Select
    Range("A1").Select
End Sub
Sub 上課實況照片()

    Sheets("B上課實況照片").Select
    Range("A1").Select
End Sub

Sub 結訓學員名冊()

    Sheets("B結訓學員名冊").Select
    Range("A1").Select
End Sub
Sub 滿意度調查統計圖()

    Sheets("滿意度調查統計圖").Select
    Range("A1").Select
End Sub
Sub 滿意度調查統計圖背景()

    Sheets("滿意度調查統計圖(背景資料)").Select
    Range("A1").Select
End Sub

休假無處去 - 寫vba

以下是第一個檔案的vba
Public tname, ty

Sub 資料輸入()

    Sheets("資料輸入").Select
    Range("a1").Select
End Sub

Sub 講師工作表()

   tname = "統計資料"
End Sub
Sub 檢查資料()

    Sheets("統計資料").Select
    Range("a1").Select
End Sub

Sub 啟動畫面()

    Sheets("啟動畫面").Select
    Range("a1").Select
End Sub

Sub 講師新增一筆()
Dim x, y, v0, v1, v2, v3, v4, v5, v6
講師工作表
x = Range("c5").Value

    v0 = "a" & x
    v0 = Sheets(tname).Range(v0).Value
   If v0 <> Empty Then
      MsgBox "無法新增"
   Else
      v0 = "a" & x
      v1 = "b" & x
      v2 = "c" & x
      v3 = "d" & x
      v4 = "e" & x
      v5 = "f" & x
      v6 = "g" & x
      

       Sheets(tname).Range(v0).Value = Range("c6").Value
       Sheets(tname).Range(v1).Value = Range("c7").Value
       Sheets(tname).Range(v2).Value = Range("c8").Value
       Sheets(tname).Range(v3).Value = Range("c9").Value
       Sheets(tname).Range(v4).Value = Range("c10").Value
       Sheets(tname).Range(v5).Value = Range("c11").Value
      Sheets(tname).Range(v6).Value = Month(Sheets(tname).Range(v2).Value)
        Range("c5").Value = x + 1
        Range("c6").Value = Empty
        Range("c7").Value = Empty
        Range("c8").Value = Empty
        Range("c9").Value = Empty
        Range("c10").Value = Empty
        Range("c11").Value = Empty
      
     End If

End Sub


Sub 講師第一筆()

    ty = 2

   講師傳值
    
Range("c5").Value = ty
End Sub
Sub 講師下一筆()

x = Range("c5").Value

 v0 = "a" & x
If Sheets(tname).Range(v0).Value <> Empty Then
 ty = x + 1
講師傳值


Else
ty = x
講師傳值


End If
Range("c5").Value = ty

End Sub
Sub 講師上一筆()

x = Range("c5").Value

 
If x = 2 Then
 ty = 2
講師傳值
  

Else
ty = x - 1
講師傳值


End If
Range("c5").Value = ty

End Sub

Sub 講師傳值()
Dim v0, v1, v2, v3, v4, v5, v6, v7

講師工作表

      v0 = "a" & ty
      v1 = "b" & ty
      v2 = "c" & ty
      v3 = "d" & ty
      v4 = "e" & ty
      v5 = "f" & ty




v0 = Sheets(tname).Range(v0).Value
v1 = Sheets(tname).Range(v1).Value
v2 = Sheets(tname).Range(v2).Value
v3 = Sheets(tname).Range(v3).Value
v4 = Sheets(tname).Range(v4).Value
v5 = Sheets(tname).Range(v5).Value

Range("c6").Value = v0
Range("c7").Value = v1
Range("c8").Value = v2
Range("c9").Value = v3
Range("c10").Value = v4
Range("c11").Value = v5
   
End Sub

Sub 講師修改()
  Dim x, y, v0, v1, v2, v3, v4, v5
講師工作表
x = Range("c5").Value

      v0 = "a" & x
      v1 = "b" & x
      v2 = "c" & x
      v3 = "d" & x
      v4 = "e" & x
      v5 = "f" & x
      

       Sheets(tname).Range(v0).Value = Range("c6").Value
       Sheets(tname).Range(v1).Value = Range("c7").Value
       Sheets(tname).Range(v2).Value = Range("c8").Value
       Sheets(tname).Range(v3).Value = Range("c9").Value
       Sheets(tname).Range(v4).Value = Range("c10").Value
       Sheets(tname).Range(v5).Value = Range("c11").Value
   MsgBox "修改成功"
 
End Sub
Sub 刪除講師()
Dim yes, tx, delx
 yes = MsgBox("您確定要刪除這一筆", vbYesNo)
   If yes = 6 Then
     tx = Range("c5").Value
     delx = "a" & tx & ":" & "f" & tx
     Sheets(tname).Select
    Range(delx).Select
    Selection.Delete Shift:=xlUp
    Sheets("資料輸入").Select
     講師下一筆

  End If
   
End Sub

新年到 - 祝大家新年快

今天大年初一
祝大新年快樂

 
妹咕數位學園歡迎網友們來信指教 妹咕信箱