2009年1月25日星期日

休假無處去 - 寫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

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禁地少女遊戲,後宮情色網,日本女優,月宮貼圖區,

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