UserForm2 UserForm4
------ [ThisWorkbook] ------
Private Sub Workbook_Open()
UserForm1.Show False
End Sub
------ [Module1] ------
Public Pr As Boolean
Public PgSt, PgLs As Integer
Sub 成績一覧表()
UserForm1.Show
End Sub
bottom top
------ [UserForm1] -------
'成績一覧表
'行列の挿入・削除をしても計算可能。
'列の挿入の時はフォームにテキストボックス
'を追加のこと。 その際、TextBoxナンバーを
'番号順につけ、UserForm3 のコード内の数値
'を変更すること。 (改良版は 10科目まで可)
Dim Lc, Lr As Integer
Private Sub CommandButton1_Click()
For i = 1 To Lc - 2 '二列分を引算
Cells(Lr + 2, i + 2).FormulaR1C1 = _
"=SUM(R2C:R[-2]C)" '縦計
If Cells(Lr + 2, i + 2) <> 0 Then
Cells(Lr + 3, i + 2).NumberFormatLocal _
= "0.0"
Cells(Lr + 3, i + 2).FormulaR1C1 = _
"=ROUND(AVERAGE(R2C:R[-3]C), 1)" '縦平均
Else
Cells(Lr + 2, i + 2) = ""
End If
Next i
For j = 1 To Lr - 1 '一行分を引算
Cells(j + 1, Lc + 2).FormulaR1C1 = _
"=SUM(RC3:RC[-2])" '横計
If Cells(j + 1, Lc + 2) <> 0 Then
Cells(j + 1, Lc + 3).NumberFormatLocal _
= "0.0"
Cells(j + 1, Lc + 3).FormulaR1C1 = _
"=ROUND(AVERAGE(RC3:RC[-3]), 1)" '横平均
Else
Cells(j + 1, Lc + 2) = ""
End If
Next j
For p = 1 To Lr - 1
If Cells(p + 1, Lc + 2) <> "" Then '順位
Cells(p + 1, Lc + 4).FormulaR1C1 = _
"=RANK(RC[-1], R2C[-1]:R" & Lr & "C[-1])"
'この Lr に数値が入り、『" & Lr & "』 で最終行を意味する
End If
Next p
Range("A1").Select
End Sub
Private Sub CommandButton2_Click() '平均消去
Range(Cells(Lr + 2, 3), Cells(Lr + 3, Lc)).ClearContents
Range(Cells(2, Lc + 2), Cells(Lr, Lc + 4)).ClearContents
SpinButton1.Value = 2
TextBox1.ControlSource = "A2" 'Box初期値
TextBox2.ControlSource = "B2"
TextBox3.ControlSource = "C2"
TextBox4.ControlSource = "D2"
TextBox5.ControlSource = "E2"
TextBox6.ControlSource = "F2"
TextBox7.ControlSource = "G2"
TextBox8.ControlSource = "J2"
TextBox9.ControlSource = "K2"
End Sub
Private Sub CommandButton3_Click()
'終了
Unload Me
End Sub
Private Sub CommandButton4_Click() '数値消去
Range(Cells(2, 3), Cells(Lr + 3, Lc + 4)).ClearContents
SpinButton1.Value = 2
TextBox1.ControlSource = "A2" 'Box初期値
TextBox2.ControlSource = "B2"
TextBox3.ControlSource = "C2"
TextBox4.ControlSource = "D2"
TextBox5.ControlSource = "E2"
TextBox6.ControlSource = "F2"
TextBox7.ControlSource = "G2"
TextBox8.ControlSource = "J2"
TextBox9.ControlSource = "K2"
End Sub
Private Sub CommandButton5_Click() '印刷
UserForm2.Show False
End Sub
Private Sub ScrollBar1_Change()
'テキストボックスとスクロールバーを連動
TextBox1.ControlSource = "A" & CStr(ScrollBar1.Value)
TextBox2.ControlSource = "B" & CStr(ScrollBar1.Value)
TextBox3.ControlSource = "C" & CStr(ScrollBar1.Value)
TextBox4.ControlSource = "D" & CStr(ScrollBar1.Value)
TextBox5.ControlSource = "E" & CStr(ScrollBar1.Value)
TextBox6.ControlSource = "F" & CStr(ScrollBar1.Value)
TextBox7.ControlSource = "G" & CStr(ScrollBar1.Value)
TextBox8.ControlSource = "J" & CStr(ScrollBar1.Value)
TextBox9.ControlSource = "K" & CStr(ScrollBar1.Value)
SpinButton1.Value = ScrollBar1.Value
End Sub
Private Sub SpinButton1_Change()
'スクロールバーとスピンボタンを連動
ScrollBar1.Value = SpinButton1.Value
End Sub
Private Sub UserForm_Initialize() '初期位置
Me.StartUpPosition = 0
If Me.StartUpPosition = 0 Then
Me.Top = 300
Me.Left = 184
End If
Lr = Range("A1").End(xlDown).Row 'データ最終行
Lc = Range("A1").End(xlToRight).Column 'データ最終列
TextBox1.ControlSource = "A2" 'Box初期値
TextBox2.ControlSource = "B2"
TextBox3.ControlSource = "C2"
TextBox4.ControlSource = "D2"
TextBox5.ControlSource = "E2"
TextBox6.ControlSource = "F2"
TextBox7.ControlSource = "G2"
TextBox8.ControlSource = "J2"
TextBox9.ControlSource = "K2"
'スピンボタンの最大最小値の設定
With SpinButton1
.Min = 2
.Max = Lr
End With
'スクロールバーの最大最小値の設定
With ScrollBar1
.Min = 2
.Max = Lr
End With
End Sub
bottom top
------ [UserForm2] -------
Private Sub CommandButton1_Click()
'ワークシート印刷
Dim Mr As Range
Dim Tt As String
Worksheets(1).Activate
Tt = "印刷範囲をマウスでドラッグ"
On Error Resume Next
Set Mr = Application.InputBox(Prompt:=Tt, Type:=8)
If Not Mr Is Nothing Then
With ActiveSheet
.PageSetup.PrintArea = Mr.Address
.PrintPreview
.PageSetup.PrintArea = ""
End With
Else
Exit Sub
End If
End Sub
Private Sub CommandButton2_Click()
'ユーザーフォーム印刷準備
UserForm3.Show
End Sub
Private Sub CommandButton3_Click()
Unload UserForm2
End Sub
------ [UserForm3] -------
Dim Re As Integer '全レコード数
Dim Fr As Integer 'フレーム数
Dim Bx As Integer 'テキストボックス数
Dim Ch As String '列名(アスキー変換)
Dim FrNm As Integer 'フレームナンバー
Dim TxNm As Integer 'テキストボックスナンバー
Private Sub CommandButton1_Click()
'印刷設定
If Re = 0 Then
MsgBox "データ未入力"
Else
UserForm4.Show '印刷設定画面
End If
If Pr = True Then
'印刷するとき表題を隠す
Label37.Visible = False
SpinButton1.Visible = False
CommandButton1.Visible = False
CommandButton2.Visible = False
For i = PgSt To PgLs
PgNm i
PrintForm '各ページ印刷
Next i
Unload UserForm3 '閉じる
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm3
End Sub
Private Sub SpinButton1_Change()
'ページ番号と各データの切り替え
PgNm SpinButton1.Value
End Sub
Private Sub UserForm_Initialize()
'フォーム起動時
Pr = False '印刷しない
Fr = 4 '１ページあたりのフレーム数
Lr = Range("A1").CurrentRegion.Rows.Count - 1
Re = Lr '全レコード数
SpinButton1.Min = 1
SpinButton1.Max = (Re - 1) \ Fr + 1 'ページ総数
PgNm 1 'ページ番号１
End Sub
Sub PgNm(ByVal p As Integer)
'各ページに全データを転送
'フォーム(ページ)内の全コントロール数
For i = 0 To Controls.Count - 1
'フレームコントロール(レコードに対応)のみ抜粋
If Left(Controls(i).Name, 5) = "Frame" Then
'フレームナンバー(ページ内)を抽出
FrNm = Val(Mid(Controls(i).Name, 6, 2))
'フレーム内(個人データ)の全コントロール数
t = Controls(i).Controls.Count
For j = 0 To (t - 1)
'フレーム内のテキストボックスのみ抜粋
If Left(Controls(i).Controls(j).Name, 7) _
= "TextBox" Then
'テキストボックスナンバー(科目に対応)を抽出
TxNm = Val(Mid(Controls(i).Controls(j).Name, 8, 2))
Bx = 9 '1フレーム内のテキストボックス数
'テキストボックスを分類
If (TxNm Mod Bx) <> 0 Then
TxNm = (TxNm Mod Bx)
Else
TxNm = Bx
End If
'列名を算出
'Chr(65)=A, ... ,Chr(71)=G, Chr(73)=I,Chr(74)=J
If TxNm >= 1 And TxNm <= (Bx - 2) Then
Ch = Chr(64 + TxNm)
Else
Ch = Chr(64 + (TxNm + 2)) '２列分スキップ
End If
'レコード(個人データ)番号
Lr = (p - 1) * Fr + FrNm
'セルのデータをテキストボックスに転送
Controls(i).Controls(j).Value _
= Range(Ch & CStr(Lr + 1)).Value
Controls(i).Controls(j).Locked = True
End If
Next j
End If
Next i
Label37.Caption = CStr(p) & "／" & _
CStr(SpinButton1.Max) & " ページ"
End Sub
bottom top
------ [UserForm4] -------
Private Sub CommandButton1_Click()
Pr = True '印刷実行
'全ページ
If OptionButton1.Value = True Then
PgSt = 1
PgLs = UserForm3.SpinButton1.Max
End If
'ページ指定
If OptionButton2.Value = True Then
PgSt = TextBox1.Value
PgLs = TextBox2.Value
End If
'現在のページ
If OptionButton3.Value = True Then
PgSt = UserForm3.SpinButton1.Value
PgLs = UserForm3.SpinButton1.Value
End If
Unload UserForm4
End Sub
Private Sub CommandButton2_Click()
Pr = False '印刷しない
Unload UserForm4
End Sub
Private Sub OptionButton2_Click()
TextBox1.Value = 1
TextBox2.Value = UserForm3.SpinButton1.Max
End Sub
Private Sub UserForm_Initialize()
'初期設定
OptionButton1.Value = True
End Sub
back top