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

1 评论:

lkjoijl 说...

熊貓情色,美女遊戲區,成人dvd,qq聊天室,aaa片免費看,手槍美女賞圖,家庭教師影片,洪爺情色,麗的色情遊戲,爽翻天成人情趣,qq聊天室,影音日誌,情色典獄長,520聊天室,080 中部人聊天室,成人文章,a片短片,成人貼圖區,免費av,杜蕾斯免費a片,柔情聊天網,豆豆聊天室,性感影片,台灣kiss情色,台灣自拍,都都成人站,小魔女自拍天堂,

aaaa片,男男貼圖區,交友私樂園,麗的線上小遊戲,卡通a片,免費情色小說,性感影片,情色聊天室,成人貼圖區,免費av,xxx383美女寫真,正妹強力版,無碼女優,女同聊天室,性愛聊天室,飯島愛,美眉,臺灣情色網,100one百萬成人貼電影,正妹強力牆,bobo寫真女郎影片,av女優,383成人,情人視訊,

3d美女圖,小莉影音像館,情色武俠小說,色美眉部落格,台灣無限貼圖區,完美女人影音網,辣美眉173show影片,自拍a片,kiss情色,熊貓貼圖區列表,自拍貼圖,s383情色大網咖,85cc免費影城,a片圖片,寫真女郎攝影網,豆豆聊天,嘟嘟貼圖,美女自拍,自拍a片,hcg 貼圖區,卡通成人網,聊天室avooo,自拍偷拍,情色文學小說,

情色交友,ut男同志聊天室,成人電影,正妹星球,無碼光碟,做愛自拍,爽翻天成人用品,歐美模特兒寫真,999成人性站,免費遊戲,成人動畫,aaaaa片俱樂部,免費線上成人影片,丁字褲美女寫真,老婆自拍,漂亮寶貝,聊天室,情色小遊戲,080 中部人聊天室,裸體寫真,線上看a片,18禁地少女遊戲,後宮情色網,日本女優,月宮貼圖區,

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