列数が多くなると管理しづらくなるので、マクロから列幅をコントロールできるようにすること。
一覧表の形式からチャート形式を作成できるようした。
UserForm1
|
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 |
Private Sub CommandButton1_Click() Application.DisplayAlerts = False If UserForm1.ComboBox1.Value = "" Or UserForm1.ComboBox2.Value = "" Then Exit Sub If UserForm1.ComboBox5.Value = "" Or UserForm1.ComboBox5.Value = "全て出力" Then suppKey = "全て出力" Else suppKey = UserForm1.ComboBox5.Text End If f = UserForm1.ComboBox1.Value & "/" & UserForm1.ComboBox2.Value & "/1" t = UserForm1.ComboBox3.Value & "/" & UserForm1.ComboBox4.Value & "/1" If IsDate(f) = False Or IsDate(t) = False Then Exit Sub If CDate(f) > CDate(t) Then Exit Sub For Each w In Sheets If w.Name = "工程" Then yn = MsgBox("工程シートが存在します。削除して続行しますか？", vbYesNo) If yn = vbNo Then Exit Sub Next w If yn = vbYes Then Sheets("工程").Delete Set w = Sheets.Add w.Name = "工程" Application.DisplayAlerts = True Call CreateProcessChart(UserForm1.ComboBox1.Value, UserForm1.ComboBox2.Value, UserForm1.ComboBox3.Value, UserForm1.ComboBox4.Value, suppKey) Unload UserForm1 End Sub Private Sub UserForm_Initialize() UserForm1.ComboBox1.AddItem Year(Now) UserForm1.ComboBox1.AddItem Year(DateAdd("yyyy", 1, Now)) UserForm1.ComboBox1.AddItem Year(DateAdd("yyyy", 2, Now)) UserForm1.ComboBox3.AddItem Year(Now) UserForm1.ComboBox3.AddItem Year(DateAdd("yyyy", 1, Now)) UserForm1.ComboBox3.AddItem Year(DateAdd("yyyy", 2, Now)) For m = 1 To 12 UserForm1.ComboBox2.AddItem m UserForm1.ComboBox4.AddItem m Next m UserForm1.ComboBox1.Text = Year(Now) UserForm1.ComboBox2.Text = Month(Now) UserForm1.ComboBox3.Text = Year(Now) UserForm1.ComboBox4.Text = Month(Now) 'UserForm1.ComboBox3.Text = Year(DateAdd("m", 3, Now)) 'UserForm1.ComboBox4.Text = Month(DateAdd("m", 3, Now)) Dim dic: Set dic = CreateObject("Scripting.Dictionary") For r = 6 To Sheets("入力").UsedRange.Rows.Count If Not dic.Exists(Sheets("入力").Cells(r, 4).Value) Then dic.Add Sheets("入力").Cells(r, 4).Value, "" Next r If Not dic.Exists("全て出力") Then dic.Add "全て出力", "" Keys = dic.Keys For i = 0 To dic.Count - 1 UserForm1.ComboBox5.AddItem Keys(i) Next i Set dic = Nothing UserForm1.ComboBox5.Text = "全て出力" End Sub |
Module2
|
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 |
Sub RestContext() On Error Resume Next Application.CommandBars("cell").Controls("列幅").Delete Application.CommandBars("cell").Controls("列幅").Delete Application.CommandBars("cell").Controls("工程フォーム表示").Delete Application.CommandBars("cell").Controls("工程フォーム表示").Delete End Sub Sub SetContext() With Application.CommandBars("cell").Controls.Add(Type:=msoControlPopup) .Caption = "列幅" With .Controls.Add(Type:=msoControlButton) ' (Type:=msoControlButton)はなくてもOK .Caption = "列幅取得" .OnAction = "getColsWidth" End With With .Controls.Add .Caption = "列幅指定(1)" .OnAction = "'setCols(2)'" '引数を渡すなら ' が必要。あるいは、ActionControl.Captionにて End With With .Controls.Add .Caption = "列幅指定(2)" .OnAction = "'setCols(3)'" End With With .Controls.Add .Caption = "列幅指定(3)" .OnAction = "'setCols(4)'" End With End With With Application.CommandBars("cell").Controls.Add .Caption = "工程フォーム表示" .OnAction = "UserFormShow" End With End Sub Sub setCols(k As Integer) For i = 3 To 51 If Sheets("設定").Cells(i, k).Value = "" Then MsgBox "設定に不正があります。" Exit Sub End If Next Sheets("入力").Activate For i = 3 To 51 Sheets("入力").Columns(i - 2).ColumnWidth = Sheets("設定").Cells(i, k).Value Next End Sub Sub getColsWidth() Sheets("設定").Activate Sheets("設定").Range("E3:E51").Value = "" For i = 3 To 51 Sheets("設定").Cells(i, 5).Value = Sheets("入力").Columns(i - 2).ColumnWidth Next End Sub |
Module3
|
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 |
Sub UserFormShow() UserForm1.Show End Sub Sub CreateProcessChart(y, m, yy, mm, suppKey) Sheets("工程").Cells(1, 1).Value = "製作先" Sheets("工程").Cells(1, 2).Value = "工番" Sheets("工程").Cells(1, 3).Value = "型式" Sheets("工程").Cells(1, 4).Value = "数量" Sheets("工程").Cells(1, 5).Value = "客先" ymd = DateAdd("m", -1, CDate(y & "/" & m & "/21")) ymdymd = CDate(yy & "/" & mm & "/20") c = 6 Do While CDate(ymd) <= CDate(ymdymd) Sheets("工程").Cells(1, c).Value = ymd ymd = DateAdd("d", 1, ymd) c = c + 1 Loop i = 2 For r = 6 To Sheets("入力").UsedRange.Rows.Count flg = True If suppKey <> "全て出力" And suppKey <> Sheets("入力").Range("D" & r).Value Then flg = False If Sheets("入力").Range("AK" & r).Value = "有" And flg = True Then Sheets("工程").Range("A" & i).Value = Sheets("入力").Range("D" & r).Value Sheets("工程").Range("B" & i).Value = Sheets("入力").Range("H" & r).Value Sheets("工程").Range("C" & i).Value = Sheets("入力").Range("J" & r).Value Sheets("工程").Range("D" & i).Value = Sheets("入力").Range("M" & r).Value Sheets("工程").Range("E" & i).Value = Sheets("入力").Range("N" & r).Value rangeAddress = Split("E,F,R,T,U", ",") chartText = Split("完成期日,本納期,出図日,製缶検査,完成検査", ",") ChartColor = Split("&HCC99FF,&HCC99FF,&H99CCFF,&H99CCFF,&H99CCFF", ",") For a = 0 To 4 If IsDate(Sheets("入力").Range(rangeAddress(a) & r).Value) = True Then c = 6 Do While Sheets("工程").Cells(1, c).Value <> "" If CDate(Sheets("工程").Cells(1, c).Value) = CDate(Sheets("入力").Range(rangeAddress(a) & r).Value) Then Sheets("工程").Cells(i, c).Value = chartText(a) Sheets("工程").Cells(i, c).Interior.Color = ChartColor(a) End If c = c + 1 Loop End If Next a fromRangeAddress = Split("AM,AP,AS,AV", ",") toRangeAddress = Split("AN,AQ,AT,AW", ",") chartTextAddress = Split("AL,AO,AR,AU", ",") ChartColor = Split("&H663399,&HFF6633,&H00CC99,&H00CCFF", ",") For a = 0 To 3 fromDate = Sheets("入力").Range(fromRangeAddress(a) & r).Value toDate = Sheets("入力").Range(toRangeAddress(a) & r).Value chartText = Sheets("入力").Range(chartTextAddress(a) & r).Value textFlag = False If IsDate(fromDate) = True Then If IsDate(toDate) = False Then toDate = fromDate c = 6 Do While Sheets("工程").Cells(1, c).Value <> "" If CDate(Sheets("工程").Cells(1, c).Value) >= CDate(fromDate) And _ CDate(Sheets("工程").Cells(1, c).Value) <= CDate(toDate) Then If textFlag = False Then Sheets("工程").Cells(i, c).Value = Sheets("工程").Cells(i, c).Value & " " & chartText textFlag = True End If Sheets("工程").Cells(i, c).Interior.Color = ChartColor(a) End If c = c + 1 Loop End If Next a i = i + 1 End If Next r Sheets("工程").Rows(1).NumberFormatLocal = "dd" Sheets("工程").Rows(1).ShrinkToFit = True Sheets("工程").Rows(1).HorizontalAlignment = xlCenter Sheets("工程").Columns.AutoFit c = 6 Do While Sheets("工程").Cells(1, c).Value <> "" Sheets("工程").Columns(c).ColumnWidth = 3.4 If c = 6 Or Day(Sheets("工程").Cells(1, c).Value) = 1 Then Sheets("工程").Cells(1, c).NumberFormatLocal = "mm/dd" End If If Weekday(Sheets("工程").Cells(1, c).Value) = 1 Then Sheets("工程").Cells(1, c).Font.Color = RGB(255, 0, 0) c = c + 1 Loop Sheets("工程").UsedRange.Borders.LineStyle = True Sheets("工程").Cells(2, 1).Select ActiveWindow.FreezePanes = True End Sub |