>即時新聞-熱門

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

0 评论:

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