帳票設計ツールの使用手引き_V1.PDF

帳票設計ツールの使用手引き

2001/１

１

/08

佐佐木

バージョンアップ-その１

主要な改善機能

・ 線情報とイメージを分離した

これにより線情報が多数ある場合画面を移動させる必要がなくなった

線情報ＸＬＳ名 イメージＸＬＳ名

線情報

イメージ情報

通常はウィンドウ枠固 定で使用する

マクロ編

①線情報 Sheet1 が変更されたら実行する ②これらの機能を利用開始、停止用 ③線情報の並び替え ④イメージ情報との連携マクロ ⑤イメージ情報 Sheet1 が変更されたら実行す ⑥Ａ４サイズの用紙に設定する ⑦枠などのオブジェクト名を表示させる ⑧テンキーでのＥｎｔｅｒのときの処理 未使用 ⑨これらの機能を利用開始、停止用 未使用 ⑩汎用帳票（11 インチ＊15 インチ） ⑪線情報の並び替え ⑫線情報との連携マクロ

①線情報

_{Sheet1 が変更されたら実行する}

Dim 変更先 Row Dim 変更先 Column Dim 変更元 Row Dim 変更元 Column Dim 範囲 As Range Dim 範囲 Row Dim 範囲 Coulum Dim 開始左 As Double Dim 開始上 As Double Dim 幅 As Double Dim 高さ As Double Dim イメージ名 xls

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Set 範囲 = Target 範囲 Row = 範囲.Rows.Count 範囲 Coulum = 範囲.Columns.Count 変更元 Row = Target.Row 変更元 Column = Target.Column データ名 xls = Cells(1, 1) イメージ名 xls = Cells(1, 3) If 変更元 Row >= 3 And _ 変更元 Row <= 200 And _ 変更元 Column >= 1 And _ 変更元 Column <= 8 Then

Call 枠作成(変更元 Row, 変更元 Column, データ名 xls, イメージ名 xls) End If

End Sub

②これらの機能を利用開始、停止用

Sub 更新開始() 'イベントの無効状態を解除する｡ Application.EnableEvents = True End Sub Sub 更新停止() '一時的にイベントを無効状態にする｡ Application.EnableEvents = False End Sub

③線情報の並び替え

Sub 並び替え() '左から、上から順にする Range("A2:H900").Select

Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, Key2:=Range("B3") _ , Order2:=xlAscending, Key3:=Range("C3"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin Range("A1").Select データ名 xls = Cells(1, 1) イメージ名 xls = Cells(1, 3) データ名 = データ名 xls & ".xls" イメージ名 = イメージ名 xls & ".xls" Windows(データ名).Activate Windows(イメージ名).Activate Range("A2:H900").Select

Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, Key2:=Range("B3") _ , Order2:=xlAscending, Key3:=Range("C3"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin

Windows(データ名).Activate

④イメージ情報との連携マクロ

Sub 枠作成(変更元 Row, 変更元 Column, データ名 xls, イメージ名 xls) データ名 = データ名 xls & ".xls" イメージ名 = イメージ名 xls & ".xls" Windows(データ名).Activate wk1 = Cells(変更元 Row, 1) wk2 = Cells(変更元 Row, 2) wk3 = Cells(変更元 Row, 3) wk4 = Cells(変更元 Row, 4) wk5 = Cells(変更元 Row, 5) wk6 = Cells(変更元 Row, 6) wk7 = Cells(変更元 Row, 7) wk8 = Cells(変更元 Row, 8) If wk8 = "" Then wk8 = " " End If Windows(イメージ名).Activate Sheets("帳票").Select Application.EnableEvents = False Cells(変更元 Row, 2) = wk2 Cells(変更元 Row, 3) = wk3 Cells(変更元 Row, 4) = wk4 Cells(変更元 Row, 5) = wk5 Cells(変更元 Row, 6) = wk6 Cells(変更元 Row, 7) = wk7 Application.EnableEvents = True Cells(変更元 Row, 8) = wk8 Cells(wk3 + 3, wk2 + 10).Select Windows(データ名).Activate End Sub

⑤イメージ情報

_{Sheet1 が変更されたら実行する}

Dim 変更先 Row Dim 変更先 Column Dim 変更元 Row Dim 変更元 Column Dim 範囲 As Range Dim 範囲 Row Dim 範囲 Coulum Dim 開始左 As Double Dim 開始上 As Double Dim 幅 As Double Dim 高さ As Double Dim 高さ変数 Dim 高さ加算

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Set 範囲 = Target 範囲 Row = 範囲.Rows.Count 範囲 Coulum = 範囲.Columns.Count Application.OnKey "{ENTER}", "テンキー" ActiveSheet.Shapes("あああ").Select テンキーENTER = Selection.Characters.Text 高さ変数 = 21 高さ加算 = 0 '用紙 If Cells(1, 1) = "汎用" Then 制限 1 = 3 制限 2 = 68 制限 3 = 11 制限 4 = 161 Else 制限 1 = 3 制限 2 = 68 制限 3 = 11 '制限 4 = 112

制限 4 = 161 End If 変更元 Row = Target.Row 変更元 Column = Target.Column If 変更元 Row >= 3 And _ 変更元 Row <= 200 And _ 変更元 Column >= 1 And _ 変更元 Column <= 8 Then 枠作成 End If

If 変更元 Row < 制限 1 Then GoTo 終了 If 変更元 Row > 制限 2 Then GoTo 終了 If 変更元 Column < 制限 3 Then GoTo 終了 If 変更元 Column > 制限 4 Then GoTo 終了 On Error GoTo エラーメッセージ ' エラー処理を設定します。 '一時的にイベントを無効状態にする｡ Application.EnableEvents = False '範囲指定の移動処理で罫線を戻す If 範囲 Row > 1 Or _ 範囲 Coulum > 1 Then

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row + 範囲 Row - 1, 変更元 Column + 範囲 Coulum - 1)).Select

With Selection.Font .Size = 14 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With

'その範囲がすべて空白なら色削除 SW_文字 = "OFF"

i = 変更元 Row

Do Until i > 変更元 Row + 範囲 Row - 1 j = 変更元 Column

Do Until j > 変更元 Column + 範囲 Coulum - 1 If Cells(i, j) <> "" Then

SW_文字 = "ON"

'MsgBox i & " " & j & Cells(i, j) i = 99 j = 99 End If j = j + 1 Loop i = i + 1 Loop '色解除 If SW_文字 = "OFF" Then

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row + 範囲 Row - 1, 変更元 Column + 範囲 Coulum - 1)).Select

Selection.Interior.ColorIndex = xlNone End If GoTo 終了 End If '色解除

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row + 範囲 Row - 1, 変更元 Column + 範囲 Coulum - 1)).Select

Selection.Interior.ColorIndex = xlNone 値 = Target.Value 値 = StrConv(値, vbUpperCase) 文字数 = Len(値) 文字 = Left(値, 1) If 文字 = "" Or 文字 = " " Or 文字 = " " Or _ 文字 = "-" Or _ 文字 = "+" Or _ 文字 = "＋" Or _

文字 = "/" Or 文字 = "*" Or 文字 = "(" Or 文字 = ")" Or _ 文字 = "+" Or _ 文字 = "¥" Or _ 文字 = "￥" Or _ 文字 = "−" Or _ 文字 = "￨" Or _ 文字 = "｜" Or _ 文字 = "┼" Or _ 文字 = "─" Or _ 文字 = "┌" Or _ 文字 = "┐" Or _ 文字 = "│" Or _ 文字 = "└" Or _ 文字 = "┘" Or _ (文字 >= "0" And 文字 <= "9") Or _ (文字 >= "１" And 文字 <= "９") Or _ (文字 >= "A" And 文字 <= "Z") Or _ (文字 >= "a" And 文字 <= "z") Or _ (文字 >= "ｱ" And 文字 <= "ﾝ") Then '半角ずらし シフト値 = 1 If 文字 = "n" Or 文字 = "N" Then シフト値 = 2 End If Else '全角ずらし シフト値 = 2 End If i = 1 j = 1 '文字をずらす Do Until i > 文字数 * シフト値 文字 = Mid(値, j, 1) If 文字 = "n" Then 文字 = "Ｎ" If 文字 = "N" Then 文字 = "Ｎ" If シフト値 = 1 Then

Cells(変更元 Row, 変更元 Column + i - 1) = 文字 Else

Range(Cells(変更元 Row, 変更元 Column + i - 1), Cells(変更元 Row, 変更元 Column + i)).Select Selection.ClearContents

Cells(変更元 Row, 変更元 Column + i - 1) = " " & 文字 'Cells(変更元 Row, 変更元 Column + i) = ""

End If i = i + シフト値 j = j + 1 Loop '漢字なら水色にする、半角なら黄色 If シフト値 = 2 Then

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row, 変更元 Column + (文字数 * シフト値 - 1))).Select

With Selection.Interior .ColorIndex = 34 .Pattern = xlSolid End With

Else

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row, 変更元 Column + (文字数 * シフト値 - 1))).Select

Selection.Interior.ColorIndex = xlNone End If If テンキーENTER = "T" Then '項目ごとの罫線作成 開始左 = 変更元 Column * 12 + 80 開始上 = 変更元 Row * 15.725 + 0 幅 = (文字数 + 1) * シフト値 * 12 高さ = 32 ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 開始左, 開始上, 幅, 高さ).Select End If GoTo 終了 エラーメッセージ: If Err Then メッセージ = "??" 'MsgBox メッセージ 変更元 Row = i 変更元 Column = j Err.Clear End If 終了:

'イベントの無効状態を解除する｡ Application.EnableEvents = True ActiveSheet.Shapes("あああ").Select Selection.Characters.Text = " " On Error Resume Next

If IsNumeric(変更元 Row) = True And _ IsNumeric(変更元 Column) = True And _ 変更元 Row >= 1 And _

変更元 Column >= 1 Then

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row, 変更元 Column)).Select End If End Sub Sub 枠作成() Dim shp As Shape On Error GoTo 枠終了 Application.EnableEvents = False '線の色を黒にする

For Each shp In Worksheets("帳票").Shapes If Left(shp.Name, 1) = "S" Then ActiveSheet.Shapes(shp.Name).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 End If Next shp

If Cells(変更元 Row, 1) <> "" Then 枠名 = Cells(変更元 Row, 1) ActiveSheet.Shapes(枠名).Select Selection.Delete Cells(変更元 Row, 1) = "" End If 開始左 = (Cells(変更元 Row, 2) + 10) * 12 + 100 開始上 = (Cells(変更元 Row, 3) + 3) * 高さ変数 + 高さ加算 幅 = (Cells(変更元 Row, 4)) * 12 高さ = Cells(変更元 Row, 5) * 高さ変数 枠名 = "S" & 開始左 & 開始上 & 幅 & 高さ

If Cells(変更元 Row, 8) = "*" Or _ Cells(変更元 Row, 8) = "＊" Then

ActiveSheet.Shapes(枠名).Select Cells(変更元 Row, 1) = "" Selection.Delete Exit Sub End If If 開始左 >= 101 And _ 開始上 >= 9 And _ 幅 >= 0 And _ 高さ >= 0 Then ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 開始左, 開始上, 幅, 高さ).Select With Selection .Name = 枠名 End With ActiveSheet.Shapes(枠名).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Cells(変更元 Row, 1) = 枠名 Cells(変更元 Row, 8) = "" End If データ名 xls = Cells(1, 1) イメージ名 xls = Cells(1, 3) 開始左 = Cells(変更元 Row, 2) 開始上 = Cells(変更元 Row, 3) 幅 = Cells(変更元 Row, 4) 高さ = Cells(変更元 Row, 5)

Call 枠情報作成(変更元 Row, shp_Name, 開始左, 開始上, 幅, 高さ, 初回 sw, データ名 xls, イメージ名 xls)

枠終了:

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 変更元 Row = Target.Row 変更元 Column = Target.Column 高さ変数 = 21 高さ加算 = 0 If 変更元 Column = 9 Then 図形の位置再設定

End If End Sub Sub 図形の位置再設定() '図形を探して位置を計算してカラム、桁を設定 Application.ScreenUpdating = False Application.EnableEvents = False Dim shp As Shape Dim R_name(1000) '赤の数値情報を青にする

Range(Cells(1, 2), Cells(100, 5)).Select Selection.Font.ColorIndex = 5 初回 sw = "ON" '枠名が重複したら、Ｒｅｃｔａｎｇｌｅに替え枠情報を取り込めるようにする '枠をコピーペースしたときの対応 i = 1

For Each shp In Worksheets("帳票").Shapes If Left(shp.Name, 1) = "S" Then If i = 1 Then '一件めはＴＢＬに移すだけ R_name(i) = shp.Name Else '２件目以降はＴＢＬの名前がすでにあるか確認 j = 1 Do While j < i R_name(i) = shp.Name

If R_name(j) = shp.Name Then

ActiveSheet.Shapes(shp.Name).Select Selection.Name = "Rectangle S" & i & j R_name(i) = "Rectangle S" & i & j j = 9999 End If j = j + 1 Loop End If i = i + 1 End If Next shp

For Each shp In Worksheets("帳票").Shapes

If Left(shp.Name, 1) = "S" Or Left(shp.Name, 9) = "Rectangle" Then ActiveSheet.Shapes(shp.Name).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 i = 3 一致 SW = "OFF" 開始左 = Application.Round(((shp.Left - 100) / 12) - 10, 1) 開始上 = Application.Round(((shp.Top - 高さ加算) / 高さ変数) - 3, 1) 幅 = Application.Round((shp.Width / 12), 1) 高さ = Application.Round((shp.Height / 高さ変数), 1) Do Until i > 100 'Cells(i, 2) = shp.Left 'Cells(i, 3) = shp.Top 'Cells(i, 4) = shp.Width 'Cells(i, 5) = shp.Height If Cells(i, 1) = shp.Name Then 一致 SW = "ON"

If Cells(i, 2) <> 開始左 Then

Range(Cells(i, 2), Cells(i, 2)).Select Selection.Font.ColorIndex = 3

End If

If Cells(i, 3) <> 開始上 Then

Range(Cells(i, 3), Cells(i, 3)).Select Selection.Font.ColorIndex = 3

End If

If Cells(i, 4) <> 幅 Then

Range(Cells(i, 4), Cells(i, 4)).Select Selection.Font.ColorIndex = 3

End If

If Cells(i, 5) <> 高さ Then

Range(Cells(i, 5), Cells(i, 5)).Select Selection.Font.ColorIndex = 3 End If Cells(i, 2) = 開始左 Cells(i, 3) = 開始上 Cells(i, 4) = 幅 Cells(i, 5) = 高さ If Cells(i, 8) = "" Then Cells(i, 8) = " " End If

データ名 xls = Cells(1, 1) イメージ名 xls = Cells(1, 3)

Call 枠情報作成(i, shp_Name, 開始左, 開始上, 幅, 高さ, 初回 sw, データ名 xls, イメージ名 xls)

'位置情報の文字を一度だけ青くするためのＳＷ 初回 sw = "OFF" 'ＬＯＯＰをぬける i = 9999 End If i = i + 1 Loop '新規図のとき位置情報作成

If (一致 SW = "OFF" And Left(shp.Name, 9) = "Rectangle") Or _ (一致 SW = "OFF" And Left(shp.Name, 1) = "S") Then

j = 3 Do Until j > 100 If Cells(j, 1) = "" Then Cells(j, 1) = shp.Name shp_Name = shp.Name Cells(j, 2) = 開始左 Cells(j, 3) = 開始上 Cells(j, 4) = 幅 Cells(j, 5) = 高さ Cells(j, 8) = " " データ名 xls = Cells(1, 1) イメージ名 xls = Cells(1, 3) Call 枠情報作成(j, shp_Name, 開始左, 開始上, 幅, 高さ, 初回 sw, データ名 xls, イメージ名 xls) j = 999 Else j = j + 1 End If Loop End If End If Next shp

Range(Cells(変更元 Row, 変更元 Column), Cells(変更元 Row, 変更元 Column)).Select Application.ScreenUpdating = True

Application.EnableEvents = True End Sub

⑥Ａ４サイズの用紙に設定する

Dim i Dim j Sub A4 罫線() '汎用罫線の削除 Range("k3:EL68").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone '外枠とセル全部に引く Range("k3:CP68").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41

End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With '枠の下を消す ' = 3 'Do Until i > 134 ' A4 罫線下を消す ' i = i + 2 'Loop A4 外枠 'Range("a1").Select 'Cells(1, 1) = "K1" End Sub Sub A4 罫線下を消す()

Range(Cells(i, 7), Cells(i, 89)).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With Selection.Borders(xlEdgeBottom).LineStyle = xlNone With Selection.Borders(xlEdgeRight) .LineStyle = xlDot .Weight = xlThin

.ColorIndex = 41 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With End Sub Sub A4 外枠() Range("K3:Cp68").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With End Sub

⑦枠などのオブジェクト名を表示させる

Sub オブジェクト表示() i = 1

For Each shp In Worksheets("帳票").Shapes

If Left(shp.Name, 1) = "S" Or Left(shp.Name, 9) = "Rectangle" Then ActiveSheet.Shapes(shp.Name).Select MsgBox shp.Name End If i = i + 1 Next shp End Sub

⑧テンキーでのＥｎｔｅｒのときの処理

Dim テンキーENTER Sub テンキー() ActiveSheet.Shapes("あああ").Select Selection.Characters.Text = "T" End Sub

⑨これらの機能を利用開始、停止用

Sub 更新開始() 'イベントの無効状態を解除する｡ Application.EnableEvents = True End Sub Sub 更新停止() '一時的にイベントを無効状態にする｡ Application.EnableEvents = False End Sub

⑩汎用帳票（

_{11 インチ＊15 インチ）}

Dim i Dim j Sub 汎用罫線() '外枠とセル全部に引く Range("k3:EL68").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With

'枠の下を消す 'i = 3 'Do Until i > 134 ' 汎用罫線下を消す ' i = i + 2 'Loop 汎用外枠 'Range("a1").Select 'Cells(1, 1) = "汎用" End Sub Sub 汎用罫線下を消す()

Range(Cells(i, 7), Cells(i, 138)).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With Selection.Borders(xlEdgeBottom).LineStyle = xlNone With Selection.Borders(xlEdgeRight) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With End Sub Sub 汎用外枠() Range("k3:EL68").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = 41 End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDot .Weight = xlThin .ColorIndex = 41 End With End Sub

⑪線情報の並び替え

Sub 並び替え()

'左から、上から順にする Range("A2:H900").Select

Selection.Sort Key1:=Range("H3"), Order1:=xlAscending, Key2:=Range("B3") _ , Order2:=xlAscending, Key3:=Range("C3"), Order3:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin Range("A1").Select End Sub

⑫線情報との連携マクロ

Sub 枠情報作成(j, shp_Name, 開始左, 開始上, 幅, 高さ, 初回 sw, データ名 xls, イメージ名 xls) Application.EnableEvents = False データ名 = データ名 xls & ".xls" イメージ名 = イメージ名 xls & ".xls" Windows(データ名).Activate Sheets("帳票").Select '赤の数値情報を青にする If 初回 sw = "ON" Then

Range(Cells(1, 2), Cells(100, 5)).Select Selection.Font.ColorIndex = 5

End If

If Cells(j, 2) <> 開始左 Then

Range(Cells(j, 2), Cells(j, 2)).Select Selection.Font.ColorIndex = 3

End If

If Cells(j, 3) <> 開始上 Then

Range(Cells(j, 3), Cells(j, 3)).Select Selection.Font.ColorIndex = 3

End If

If Cells(j, 4) <> 幅 Then

Range(Cells(j, 4), Cells(j, 4)).Select Selection.Font.ColorIndex = 3

End If

If Cells(j, 5) <> 高さ Then

Range(Cells(j, 5), Cells(j, 5)).Select Selection.Font.ColorIndex = 3 End If Cells(j, 1) = shp_Name Cells(j, 2) = 開始左 Cells(j, 3) = 開始上 Cells(j, 4) = 幅 Cells(j, 5) = 高さ If Cells(j, 8) = "" Then Cells(j, 8) = " " End If Windows(イメージ名).Activate End Sub