1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 |
Public Sub subEX_print() If NewfilePass.Trim.Length = 0 OrElse Dir(NewfilePass) = "" Then MessageBox.Show("処理が正常終了していません。確認してください " & ControlChars.CrLf & NewfilePass.ToString, "処理の確認") Exit Sub End If Dim app As Object 'エクセルアプリケーションの定義 Dim book As Object 'ブックの定義 Dim sheet As Object 'シートの定義 '各セルの値を取得 ' Dim j As Integer '------エクセルファイルを開く&表示------- app = CreateObject("Excel.Application") app.application.visible = True book = app.Workbooks.Open(NewfilePass) 'エクセルファイルのopen sheet = book.Worksheets(1) '===エクセルデータ日付を入れる <==日付の処理 sheet.cells(4, 1).value = oneWeek.ToString("MM/dd") sheet.cells(12, 1).value = oneWeek.AddDays(1).ToString("MM/dd") sheet.cells(20, 1).value = oneWeek.AddDays(2).ToString("MM/dd") sheet.cells(28, 1).value = oneWeek.AddDays(3).ToString("MM/dd") sheet.cells(36, 1).value = oneWeek.AddDays(4).ToString("MM/dd") sheet.cells(44, 1).value = oneWeek.AddDays(5).ToString("MM/dd") sheet.cells(52, 1).value = oneWeek.AddDays(6).ToString("MM/dd") sheet.cells(8, 1).value = WeekdayName(Weekday(oneWeek)).Substring(0, 1) sheet.cells(16, 1).value = WeekdayName(Weekday(oneWeek.AddDays(1))).Substring(0, 1) sheet.cells(24, 1).value = WeekdayName(Weekday(oneWeek.AddDays(2))).Substring(0, 1) sheet.cells(32, 1).value = WeekdayName(Weekday(oneWeek.AddDays(3))).Substring(0, 1) sheet.cells(40, 1).value = WeekdayName(Weekday(oneWeek.AddDays(4))).Substring(0, 1) sheet.cells(48, 1).value = WeekdayName(Weekday(oneWeek.AddDays(5))).Substring(0, 1) sheet.cells(56, 1).value = WeekdayName(Weekday(oneWeek.AddDays(6))).Substring(0, 1) For yy As Integer = 8 To 56 Step 8 If sheet.cells(yy, 1).value = "日" Then sheet.cells(yy, 1).font.color = Color.Red sheet.cells(yy, 1).font.bold = True sheet.cells(yy - 4, 1).font.color = Color.Red sheet.cells(yy - 4, 1).font.bold = True End If Next '-----エクセルデータの書き込み------ Dim conn As New SqlConnection() conn.ConnectionString = My.Settings.hozenkouteikanriConnectionString Dim cmd As New SqlCommand cmd.Connection = conn cmd.CommandType = CommandType.Text cmd.CommandText = "SELECT t_neo_schedule.sekou_day, t_neo_sagyou_cd.bucd, t_neo_sagyou_cd.meisyou, t_neo_sagyou_cd.cd, t_neo_schedule.txtbName, t_neo_schedule.txtbtxt, t_neo_schedule.txtbWM, t_neo_schedule.g_mei, t_neo_schedule.hiruyoru, t_neo_sagyou_cd.tani01, t_neo_sagyou_cd.tani02, t_neo_sagyou_cd.tani03, t_neo_sagyou_cd.tani04, t_syain.ryakusyouSyaimei, t_kaisya.ryakusyou, t_kaisya.iroShitei FROM t_kaisya INNER JOIN t_syain ON t_kaisya.id = t_syain.kaisyaId RIGHT OUTER JOIN t_neo_schedule INNER JOIN t_neo_sagyou_cd ON t_neo_schedule.gyoumuId = t_neo_sagyou_cd.id ON t_syain.id = t_neo_schedule.syainId WHERE t_neo_schedule.sekou_day BETWEEN " & mo_ck.funDateCkN_Null(oneWeek) & " AND " & mo_ck.funDateCkN_Null(oneweek_end) & " AND t_neo_schedule.syainId > 0 ORDER BY t_neo_schedule.sekou_day, t_neo_schedule.txtbName, t_neo_sagyou_cd.cd" Dim previousConnectionState As ConnectionState = conn.State Try If conn.State = ConnectionState.Closed Then conn.Open() End If Dim reader As SqlDataReader reader = cmd.ExecuteReader() Using reader While reader.Read Debug.WriteLine(mo_ck.str(reader.GetValue(3))) Dim iRowStart As Integer = 0 If mo_ck.dat(reader.GetValue(0)) = oneWeek Then iRowStart = 0 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(1) Then iRowStart = 8 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(2) Then iRowStart = 16 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(3) Then iRowStart = 24 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(4) Then iRowStart = 32 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(5) Then iRowStart = 40 ElseIf mo_ck.dat(reader.GetValue(0)) = oneWeek.AddDays(6) Then iRowStart = 48 End If If mo_ck.str(reader.GetValue(2)).Contains("有休") Then For i As Integer = 0 To 6 If IsNothing(yuku(funyoubi(iRowStart), i)) Then yuku(funyoubi(iRowStart), i) = mo_ck.str(reader.GetValue(13)) Exit For End If Next ElseIf mo_ck.str(reader.GetValue(2)).Contains("明け") Then For i As Integer = 0 To 14 If IsNothing(ake(funyoubi(iRowStart), i)) Then ake(funyoubi(iRowStart), i) = mo_ck.str(reader.GetValue(13)) Exit For End If Next ElseIf mo_ck.str(reader.GetValue(2)).Contains("講習") Then For i As Integer = 0 To 14 If IsNothing(kousyu(funyoubi(iRowStart), i)) Then kousyu(funyoubi(iRowStart), i) = mo_ck.str(reader.GetValue(13)) Exit For End If Next ' ElseIf mo_ck.str(reader.GetValue(2)).Contains("事務") Then ElseIf mo_ck.str(reader.GetValue(3)) = "012" OrElse mo_ck.str(reader.GetValue(3)) = "310-01" Then For i As Integer = 0 To 7 If IsNothing(jimu(funyoubi(iRowStart), i)) Then jimu(funyoubi(iRowStart), i) = mo_ck.str(reader.GetValue(13)) Exit For End If Next Else '==施工日付が月曜日から始まる '===各曜日に対して、1度だけの処理 見出し書き出し If midashi_day <> mo_ck.dat(reader.GetValue(0)) Then hyoudaikakikomi(mo_ck.dat(reader.GetValue(0)), sheet, iRowStart) '====表題の書き込み midashi_day = mo_ck.dat(reader.GetValue(0)) End If subCell(sheet, iRowStart, reader) '===各行への書き込み End If End While End Using Finally If previousConnectionState = ConnectionState.Closed Then conn.Close() End If End Try app.DisplayAlerts = False '保存時の問合せのダイアログを非表示に設定 sheet.SaveAs(NewfilePass) 'ファイルに保存 app.DisplayAlerts = True '元に戻す MRComObject(sheet) 'xlSheet の開放 REM xlSheets(の開放) book.Close(False) 'xlBook を閉じる MRComObject(book) 'xlBook の開放 'xlBooks の開放 app.Quit() 'Excelを閉じる MRComObject(app) 'xlApp を開放 End Sub |