vb做的懒人值班表

因为每次都得填重复的 弄了个这个 不过下次改进下 弄开机自启

Option Explicit
Dim wapp As New Word.Application
Dim wapp1 As New Word.Application
Dim wapp2 As New Word.Application

Dim i As Integer
Dim wdoc As Word.Document
Dim wdoc2 As Word.Document
Dim zhoumo As Integer
Dim zhoumo1 As Integer
Dim zhoumo2 As Integer
Dim friday As Integer
Dim friday1 As Integer
Dim friday2 As Integer











Private Sub Command1_Click()

'Dim wdoc As Word.Document
Dim tablew As Word.table

Dim c As String
Static v As Long
Dim w As String
Dim q As String
Dim time As String
Dim ii As Integer
Dim iii As Integer
Dim day1 As Integer


'i = i + 1

ii = i - 4
iii = ii - i

'c = Year(Now) & "." & Month(Now)
c = Format(Now, "yyyy.mm.dd")



v = Weekday(Date)
If v = 1 Then
 w = "8:00"
q = "周末"
time = "12小时"

ElseIf v = 2 Then
 w = "17:00"
q = "延值"
time = "3小时"

ElseIf v = 3 Then
 w = "17:00"
q = "延值"
time = "3小时"

ElseIf v = 4 Then
 w = "17:00"
q = "延值"
time = "3小时"

ElseIf v = 5 Then
w = "17:00"
q = "延值"
time = "3小时"

ElseIf v = 6 Then
w = "17:00"
q = "延值"
time = "3小时"


If FileLen(App.Path & "\1234.txt") = 0 Then
Open "1234.txt" For Output As #1
friday2 = friday2 + 1
Print #1, friday2,
Close #1
Else
Open "1234.txt" For Input As #1
Input #1, friday1
End If
Close #1


'friday2 = friday2 + 1

'Open "1234.txt" For Output As #1
' print 语句后面加上逗号，
' 输出后不换行、输出项目后面自动加空格补齐到“制表定位”处
'Print #1, friday2,
'Print #1, "20150112103831",
'Print #1, "6.62",
'Print #1, "6.62",
'Print #1, "0.00",
'Print #1, "0.00",
'Print #1, "6.62",
'Close
'Open "1234.txt" For Input As #1
'Input #1, friday1 '读取文件中的一个数据，存放到变量a中
'Close


friday = friday1 + 1

Open "1234.txt" For Output As #1
' print 语句后面加上逗号，
' 输出后不换行、输出项目后面自动加空格补齐到“制表定位”处
Print #1, friday,
'Print #1, "20150112103831",
'Print #1, "6.62",
'Print #1, "6.62",
'Print #1, "0.00",
'Print #1, "0.00",
'Print #1, "6.62",
Close










ElseIf v = 7 Then
w = "8:00"
q = "周末"
time = "12小时"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~存周六的次数
'zhoumo2 = 1
zhoumo2 = zhoumo2 + 1

Open "123.txt" For Output As #1
' print 语句后面加上逗号，
' 输出后不换行、输出项目后面自动加空格补齐到“制表定位”处
Print #1, zhoumo2,
'Print #1, "20150112103831",
'Print #1, "6.62",
'Print #1, "6.62",
'Print #1, "0.00",
'Print #1, "0.00",
'Print #1, "6.62",
Close
Open "123.txt" For Input As #1
Input #1, zhoumo1 '读取文件中的一个数据，存放到变量a中
Close


zhoumo = zhoumo1 - 1

Open "123.txt" For Output As #1
' print 语句后面加上逗号，
' 输出后不换行、输出项目后面自动加空格补齐到“制表定位”处
Print #1, zhoumo,
'Print #1, "20150112103831",
'Print #1, "6.62",
'Print #1, "6.62",
'Print #1, "0.00",
'Print #1, "0.00",
'Print #1, "6.62",
Close
End If






Set wdoc = wapp.Documents.Open("C:\Users\Administrator\Desktop\新建 Microsoft Word 文档 (4).docx")
'wapp.Visible = True
wapp.Selection.EndKey unit:=wdStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Dim table
'Set table = wapp.ActiveDocument.Tables(1)

'Call wapp.ActiveDocument.Tables.Add(wapp.Application.Selection.Range, 1, 7, 1, 0)

 Call wapp.ActiveDocument.Tables.Add(wapp.Application.Selection.Range, NumRows:=1, NumColumns:= _
        7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed)
        
    With wapp.Selection.Tables(1)
        If .Style <> "网格型" Then
            .Style = "网格型"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
'Selection.TypeText Text:="d ds ds ds ds ds sd "

wapp.ActiveDocument.Tables(1).Cell(i, 1).Range.InsertAfter c
wapp.ActiveDocument.Tables(1).Cell(i, 2).Range.InsertAfter w
wapp.ActiveDocument.Tables(1).Cell(i, 3).Range.InsertAfter "20:00"
wapp.ActiveDocument.Tables(1).Cell(i, 4).Range.InsertAfter "上传医保数据,处理his系统故障"
wapp.ActiveDocument.Tables(1).Cell(i, 5).Range.InsertAfter q
wapp.ActiveDocument.Tables(1).Cell(i, 6).Range.InsertAfter time
wapp.ActiveDocument.Tables(1).Cell(i, 7).Range.InsertAfter "liuchang"


i = i - 1
wapp.ActiveDocument.Tables(1).Cell(i, 4).Width = 100 'Range.InsertAfter "上传医保数据,处理his系统故障"

End Sub

Private Sub Command2_Click()
Dim day2 As Integer
Dim day4 As String

Set wdoc = wapp.Documents.Open("C:\Users\Administrator\Desktop\新建 Microsoft Word 文档 (4).docx")
wapp.Visible = True
wapp.Selection.EndKey unit:=wdStory
day2 = Format(Now, "dd")

If day2 = 8 Then
wapp.Selection.EndKey unit:=wdStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 Call wapp.ActiveDocument.Tables.Add(wapp.Application.Selection.Range, NumRows:=1, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed)
    With wapp.Selection.Tables(1)
        If .Style <> "网格型" Then
            .Style = "网格型"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
    wapp.ActiveDocument.Tables(1).Cell(i + 1, 1).Width = 103
     wapp.ActiveDocument.Tables(1).Cell(i + 1, 2).Width = 130
      wapp.ActiveDocument.Tables(1).Cell(i + 1, 3).Width = 102
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 4).Width = 130
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 1).Height = 60
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 2).Height = 60
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 3).Height = 60
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 4).Height = 60
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 1).Range.InsertAfter "pizhunren" ' = 103
       wapp.ActiveDocument.Tables(1).Cell(i + 1, 3).Range.InsertAfter "shenheren" '= 103
       
       wapp.Selection.EndKey unit:=wdStory
       day4 = wdoc.Tables(1).Cell(6, 6).Range.Text
       Selection.TypeText Text:=Left(day4, Len(day4) - 4)
       'ActiveDocument.BuiltInDocumentProperties(wdPropertyLines).Value
       
    End If
End Sub

Private Sub Form_Load()

'i = 1
Dim day As Integer
day = Format(Now, "dd")
Text1.Text = day
If day = 8 Then
Set wdoc = wapp.Documents.Open("C:\Users\Administrator\Desktop\新建 Microsoft Word 文档 (4).docx")
wapp.Visible = True
wapp.Selection.EndKey unit:=wdStory

 Selection.Font.Name = "Adobe 黑体 Std R"
    Selection.Font.Size = 22

    Selection.TypeText Text:="值班"
   
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter














'————————————————————————————————————————————————————————表
Set wdoc = wapp.Documents.Open("C:\Users\Administrator\Desktop\新建 Microsoft Word 文档 (4).docx")
'wapp.Visible = True
wapp.Selection.EndKey unit:=wdStory





'Dim table
'Set table = wapp.ActiveDocument.Tables(1)
'i = i - 1
 Selection.Font.Name = "宋体"
    Selection.Font.Size = 10
Call wapp.ActiveDocument.Tables.Add(wapp.Application.Selection.Range, 1, 7, 1, 0)


'wapp.ActiveDocument.Tables(1).Cell(i, 4).Width = 100 'Range.InsertAfter "上传医保数据,处理his系统故障"
wapp.ActiveDocument.Tables(1).Cell(1, 1).Range.InsertAfter "c"
wapp.ActiveDocument.Tables(1).Cell(1, 2).Range.InsertAfter "w"
wapp.ActiveDocument.Tables(1).Cell(1, 3).Range.InsertAfter "20:00"
wapp.ActiveDocument.Tables(1).Cell(1, 4).Range.InsertAfter "上传医保数据,处理his系统故障"
wapp.ActiveDocument.Tables(1).Cell(1, 4).Width = 100
wapp.ActiveDocument.Tables(1).Cell(1, 5).Range.InsertAfter "q"
wapp.ActiveDocument.Tables(1).Cell(1, 6).Range.InsertAfter "time"
wapp.ActiveDocument.Tables(1).Cell(1, 7).Range.InsertAfter "liuchang"
End If







End Sub

Private Sub Timer1_Timer()
Label1.Caption = Format(Now, "yyyy-mm-dd")

End Sub