エクセルVBAで作る 小規模用情報共有DBシステム ファイルアップロードも可能 テスト投稿
●演習シート用 Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge <= 100 Then If Target.Count > 1 Then Exit Sub Dim t_address Dim t_value t_address = Target.Address(False, False) t_value = Target.Value 'Target.Addressを条件にテーブルからwordを取り出す 'wordとTarget.Valueを比較し、合っていたら文字の色を青にする、以外は赤にする 'xxと入れたら答えを記入 If t_value = "" Then Exit Sub Dim dic_obj_select_info As Object Set dic_obj_select_info = CreateObject("Scripting.Dictionary") Dim select_dto As Object dic_obj_select_info.Add GB_PLACE, t_address Set select_dto = select_info(GB_T_FILL_WORD_TABLE, dic_obj_select_info, fill_word_table_map) ' Debug.Print "DB" & select_dto.Item(GB_WORD) ' Debug.Print "セル" & select_dto.Item(GB_WORD) If select_dto.Count > 0 Then If t_value = select_dto.Item(1).Item(GB_WORD) Then Range(t_address).Font.ColorIndex = 5 Range(t_address).Font.Bold = True 'xxと入力された場合は答えを出す。 ElseIf t_value = "xx" Or t_value = "xx" Then Range(t_address).Value = select_dto.Item(1).Item(GB_WORD) Range(t_address).Font.ColorIndex = 1 Range(t_address).Font.Bold = True Else Range(t_address).Font.ColorIndex = 3 Range(t_address).Font.Bold = True End If End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub ●edit_form用 Private Sub Label6_Click() End Sub Private Sub rate_ComboBox_Change() End Sub Private Sub regist_CommandButton_Click() Call rgist_fill_question(2) End Sub Private Sub get_col_CommandButton_Click() edit_Form.col_TextBox = ActiveCell.Column End Sub Private Sub get_row_CommandButton_Click() edit_Form.row_TextBox.Value = ActiveCell.row End Sub Private Sub TextBox1_Change() End Sub Private Sub summary_TextBox_Change() End Sub Private Sub text_CommandButton_Click() '---------------------temporary_tableからidを取得 Dim id As Long Dim setter As Object Dim getter As Object Set setter = CreateObject("Scripting.Dictionary") Set getter = CreateObject("Scripting.Dictionary") setter.Add GB_T_ID, 1 Set getter = select_info(GB_T_TEMPORARY_TABLE, setter, temporary_table_map) id = getter.Item(1).Item(GB_ID) Set setter = Nothing Set getter = Nothing '---------------------law_info_tableのテキストページをフォームの値で更新する Dim text_page As Long Dim setter_target As Object Dim setter_value As Object Set setter_target = CreateObject("Scripting.Dictionary") Set setter_value = CreateObject("Scripting.Dictionary") text_page = Me.text_TextBox setter_target.Add GB_ID, id setter_value.Add GB_TEXT, text_page Call update_info(GB_T_LAW_INFO_TABLE, setter_target, setter_value, law_info_table_map) '---------------------temporary_tableのテキストページも更新 Set setter_target = Nothing Set setter_target = CreateObject("Scripting.Dictionary") setter_target.Add GB_T_ID, 1 Call update_info(GB_T_TEMPORARY_TABLE, setter_target, setter_value, temporary_table_map) Set setter_target = Nothing Set setter_value = Nothing MsgBox "登録しました" End Sub Private Sub text_TextBox_Change() End Sub Private Sub UserForm_Initialize() ' ' 重要度の値をテンポラリーテーブルから取得 ' Dim dic_obj_select_info As Object ' Dim select_dto As Object ' Dim t_rate As Object ' ' 検索条件の入れ物を用意 ' Set dic_obj_select_info = CreateObject("Scripting.Dictionary") ' ' dic_obj_select_info.Add GB_ID, 1 ' ' select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map) ' ' t_rate = select_dto.Item(1).Item(GB_RATE) ' With rate_ComboBox .AddItem 1 .AddItem 2 .AddItem 3 End With ' If t_rate <> "" Then ' ' rate_ComboBox.ListIndex = t_rate ' ' Else ' ' rate_ComboBox.ListIndex = -1 ' ' ' End If ' End Sub ★edit_form用各ボタン名 licence_TextBox category_TextBox no_TextBox get_row_CommandButton row_TextBox get_col_CommandButton col_TextBox rate_ComboBox text_TextBox text_CommandButton regist_CommandButton ●fill_chara_Form用 Private Sub CommandButton1_Click() End Sub Private Sub create_fill_chara_Click() Call create_fill_in_the_blank_character End Sub Private Sub regist_fill_chara_Click() Dim last_row As Long Dim last_col As Long last_row = fill_chara_Form.last_row_text last_col = fill_chara_Form.last_col_text Call register_fill_in_the_blank_character(last_row, last_col) End Sub Private Sub delete_line_Button_Click() Call delete_line End Sub Private Sub drow_line_Button_Click() Call drow_line End Sub Private Sub drow_line_Button2_Click() Call drow_line2 End Sub Private Sub row_delete_Click() Call row_delete_1 End Sub Private Sub row_insert_Click() Call row_insert_1 End Sub ★fill_chara_Form用各ボタン row_insert row_delete drow_line_Button drow_line_Button2 delete_line_Button ●index_Form Private Sub CommandButton1_Click() regist_Form.Show vbModeless End Sub Private Sub open_law_Form_Click() law_Form.Show vbModeless End Sub Private Sub opne_fill_chara_form_Click() fill_chara_Form.Show vbModeless End Sub Private Sub UserForm_Click() End Sub ★index_Form用各ボタン open_law_Form opne_fill_chara_form CommandButton1 ●law_Form 'Private Sub CommandButton1_Click() ' ' ' Dim str As String ' ' str = UserForm1.TextBox1.Value ' ' '改行コードを削除 ' ' str = Replace(str, vbCrLf, "") '' Debug.Print str ' ' '' Call get_kanji(str) ' Call decompose_string(str) ' 'End Sub Private Sub CommandButton2_Click() Call create_fill_in_the_blank_character End Sub Private Sub CommandButton3_Click() End Sub Private Sub TextBox1_Change() End Sub Private Sub TextBox3_Change() End Sub Private Sub law_CommandButton_Click() Dim str As String str = law_Form.law_TextBox.Value ' '改行コードを削除 ' str = Replace(str, vbCrLf, "") ' ' Call decompose_string(str) ' str = Replace(str, vbCrLf, "/") Call decompose_string_direct(str) End Sub Private Sub law_TextBox_Change() End Sub Private Sub reset_Button_Click() Call reset_question End Sub ★law_Form用ボタン reset_Button law_CommandButton ●regist_Form Private Sub category_ComboBox_Change() End Sub Private Sub get_col_CommandButton_Click() regist_Form.col_TextBox = ActiveCell.Column End Sub Private Sub get_row_CommandButton_Click() regist_Form.row_TextBox.Value = ActiveCell.row End Sub Private Sub Label9_Click() End Sub Private Sub rate_ComboBox_Change() End Sub Private Sub summary_TextBox_Change() End Sub Private Sub UserForm_Initialize() With licence_ComboBox .AddItem "消防4類乙" End With licence_ComboBox.ListIndex = 0 With category_ComboBox .AddItem "暗記" End With category_ComboBox.ListIndex = 0 With rate_ComboBox .AddItem 1 .AddItem 2 .AddItem 3 End With rate_ComboBox.ListIndex = 0 End Sub Private Sub CommandButton1_Click() End Sub Private Sub regist_CommandButton_Click() If regist_Form.no_TextBox = "" Then MsgBox "NOが指定されていません" End End If Call rgist_fill_question(1) End Sub Private Sub UserForm_Click() End Sub ★regist_Form用ボタン licence_ComboBox category_ComboBox no_TextBox get_row_CommandButton row_TextBox get_col_CommandButton col_TextBox rate_ComboBox regist_CommandButton ●DB用 Option Explicit Enum law_info_table id = 1 licence category num row col t_rate t_summary del_flg t_text t_text_name times sub_category End Enum Enum fill_word_table id = 1 place word End Enum Enum temporary_table t_id = 1 id licence category num row col t_rate t_summary t_text End Enum Enum number_table t_id = 1 number1 number2 number3 End Enum Enum question_cycle_table t_id = 1 license sub_category times End Enum Function select_info(table_name As String, ByVal select_dto As Object, table_map As Object) As Object '情報の曖昧検索をする関数 '引数1:検索するテーブル名 '引数2:検索条件 '引数3:検索対象テーブルのマッピング情報 Dim tbList As ListObject Dim record_count As Long Dim i As Long Dim j As Long Dim dicKey_select As Variant Dim serch_count As Long Dim record As String Dim search_Word As String serch_count = 0 ' Dim dicItem_select As Variant Dim dicKey_table As Variant dicKey_select = select_dto.keys ' dicItem_select = select_dto.items dicKey_table = table_map.keys '検索結果返却用 Dim dic_obj_result As Object Set dic_obj_result = CreateDictionary ' Worksheets(table_name).Activate Set tbList = CreateTableList(table_name) 'Set tbList = Worksheets(table_name).ListObjects(table_name) record_count = tbList.ListRows.Count With ThisWorkbook.Worksheets(table_name) For i = 2 To record_count + 1 For j = 0 To UBound(dicKey_select) 'テーブルの検索対象情報 'todo 検索語に関しては前段階で小文字に変換できないか考える 'dictoinaryのキーの配列はすでに持ってるのだから、開けて変換して戻すくらいはできるはず search_Word = "" record = "" search_Word = select_dto.Item(dicKey_select(j)) search_Word = StrConv(LCase(search_Word), vbNarrow) 'search_Word = Replace(search_Word, " ", "*") record = .Cells(i, table_map.Item(dicKey_select(j))).Value record = StrConv(LCase(record), vbNarrow) ' If Not record Like "*" & search_Word & "*" Then ' ' GoTo Skip ' ' End If If Not record Like search_Word Then GoTo Skip End If ' If .Cells(i, table_map.Item(dicKey_select(j))).Value <> select_dto.Item(dicKey_select(j)) Then ' ' GoTo Skip ' ' End If Next j '子ディクショナリ Dim c_dic_obj_result As Object Set c_dic_obj_result = CreateDictionary serch_count = serch_count + 1 'ここに来れたなら、条件がすべて一致しているはず。 For j = 0 To UBound(dicKey_table) 'テーブルの目的の行を追加する c_dic_obj_result.Add dicKey_table(j), .Cells(i, table_map.Item(dicKey_table(j))).Value Next j '親ディクショナリに子ディクショナリを追加 dic_obj_result.Add serch_count, c_dic_obj_result 'for文を抜ける ' Exit For Skip: Next i End With Set select_info = dic_obj_result End Function Function insert_info(table_name As String, ByVal insert_dto As Object, table_map As Object) '情報の登録を行う関数 '引数1:登録を行テーブル名 '引数2:登録内容 '引数3:登録テーブルのマッピング情報 Dim dicKey_table As Variant Dim dicKey_insert As Variant Dim i As Long Dim tbList As ListObject Set tbList = Worksheets(table_name).ListObjects(table_name) dicKey_insert = insert_dto.keys dicKey_table = table_map.keys With tbList.ListRows.Add For i = 0 To UBound(dicKey_insert) .Range(table_map.Item(dicKey_insert(i))).Value = insert_dto(dicKey_insert(i)) Next i End With End Function Function update_info(table_name As String, ByVal search_dto, ByVal update_dto As Object, table_map As Object) '情報を更新する関数 検索条件は複数可能 '引数1:更新を行テーブル名 '引数2:更新を行うレコードの条件(ID=1)とか '引数2:更新内容 '引数3:更新テーブルのマップ Dim record_count As Long Dim dicKey_serch As Variant Dim dicKey_update As Variant Dim dicKey_table As Variant Dim tbList As ListObject Set tbList = Worksheets(table_name).ListObjects(table_name) Dim i As Long Dim j As Long record_count = tbList.ListRows.Count dicKey_serch = search_dto.keys dicKey_update = update_dto.keys dicKey_table = table_map.keys With Worksheets(table_name) For i = 2 To record_count + 1 For j = 0 To UBound(dicKey_serch) If .Cells(i, table_map.Item(dicKey_serch(j))).Value <> search_dto.Item(dicKey_serch(j)) Then GoTo Skip End If Next j 'ここに来れたなら、条件がすべて一致しているはず。 For j = 0 To UBound(dicKey_update) .Cells(i, table_map.Item(dicKey_update(j))).Value = update_dto.Item(dicKey_update(j)) Next j Skip: Next i End With End Function Function law_info_table_map() As Object 'テーブル内でのカラムの位置をマッピングするやーつ 'このカラム名称だと1列目とか~ Dim dic_obj_law_info_table As Object Set dic_obj_law_info_table = CreateObject("Scripting.Dictionary") dic_obj_law_info_table.Add GB_ID, law_info_table.id dic_obj_law_info_table.Add GB_LICENCE, law_info_table.licence dic_obj_law_info_table.Add GB_CATEGORY, law_info_table.category dic_obj_law_info_table.Add GB_NUM, law_info_table.num dic_obj_law_info_table.Add GB_ROW, law_info_table.row dic_obj_law_info_table.Add GB_COL, law_info_table.col dic_obj_law_info_table.Add GB_RATE, law_info_table.t_rate dic_obj_law_info_table.Add GB_SUMMARY, law_info_table.t_summary dic_obj_law_info_table.Add GB_DEL_FLG, law_info_table.del_flg dic_obj_law_info_table.Add GB_TEXT, law_info_table.t_text dic_obj_law_info_table.Add GB_C_TEXT_NAME, law_info_table.t_text_name dic_obj_law_info_table.Add GB_C_TIMES, law_info_table.times dic_obj_law_info_table.Add GB_C_SUB_CATEGORY, law_info_table.sub_category Set law_info_table_map = dic_obj_law_info_table End Function Function fill_word_table_map() As Object Dim dic_obj_fill_word_table As Object Set dic_obj_fill_word_table = CreateObject("Scripting.Dictionary") dic_obj_fill_word_table.Add GB_ID, fill_word_table.id dic_obj_fill_word_table.Add GB_PLACE, fill_word_table.place dic_obj_fill_word_table.Add GB_WORD, fill_word_table.word Set fill_word_table_map = dic_obj_fill_word_table End Function Function temporary_table_map() As Object Dim dic_obj_temporary_table As Object Set dic_obj_temporary_table = CreateObject("Scripting.Dictionary") dic_obj_temporary_table.Add GB_T_ID, temporary_table.t_id dic_obj_temporary_table.Add GB_ID, temporary_table.id dic_obj_temporary_table.Add GB_LICENCE, temporary_table.licence dic_obj_temporary_table.Add GB_CATEGORY, temporary_table.category dic_obj_temporary_table.Add GB_NUM, temporary_table.num dic_obj_temporary_table.Add GB_ROW, temporary_table.row dic_obj_temporary_table.Add GB_COL, temporary_table.col dic_obj_temporary_table.Add GB_RATE, temporary_table.t_rate dic_obj_temporary_table.Add GB_SUMMARY, temporary_table.t_summary dic_obj_temporary_table.Add GB_TEXT, temporary_table.t_text Set temporary_table_map = dic_obj_temporary_table End Function Function number_table_map() As Object Dim dic_obj_temporary_table As Object Set dic_obj_temporary_table = CreateObject("Scripting.Dictionary") dic_obj_temporary_table.Add GB_T_ID, number_table.t_id dic_obj_temporary_table.Add GB_NUMBER1, number_table.number1 dic_obj_temporary_table.Add GB_NUMBER2, number_table.number2 dic_obj_temporary_table.Add GB_NUMBER3, number_table.number3 Set number_table_map = dic_obj_temporary_table End Function Function question_cycle_table_map() As Object Dim dic_obj As Object Set dic_obj = CreateDictionary dic_obj.Add GB_ID, question_cycle_table.t_id dic_obj.Add GB_LICENCE, question_cycle_table.license dic_obj.Add GB_C_SUB_CATEGORY, question_cycle_table.sub_category dic_obj.Add GB_C_TIMES, question_cycle_table.times Set question_cycle_table_map = dic_obj End Function ●common_function Option Explicit Function CreateDictionary() As Object 'ディクショナリーオブジェクトを作成して返却する関数 Dim dicObj As Object Set dicObj = CreateObject("Scripting.Dictionary") Set CreateDictionary = dicObj End Function Function CreateTableList(tableName As String) As Object Dim tableList As ListObject Set tableList = ThisWorkbook.Worksheets(tableName).ListObjects(tableName) Set CreateTableList = tableList End Function ●module1 Option Explicit 'law_info_table Public Const GB_ID = "ID" Public Const GB_LICENCE = "licence" Public Const GB_CATEGORY = "category" Public Const GB_NUM = "num" Public Const GB_ROW = "row" Public Const GB_COL = "col" Public Const GB_RATE = "rate" Public Const GB_SUMMARY = "summary" Public Const GB_DEL_FLG = "del_flg" Public Const GB_TEXT = "text" Public Const GB_C_TEXT_NAME = "text_name" Public Const GB_C_TIMES = "times" Public Const GB_C_SUB_CATEGORY = "sub_category" Public Const GB_PLACE = "place" Public Const GB_WORD = "word" Public Const GB_T_ID = "t_ID" Public Const GB_TABLE = "table" Public Const GB_NUMBER1 = "number1" Public Const GB_NUMBER2 = "number2" Public Const GB_NUMBER3 = "number3" 'question_cycle_table Public Const GB_C_ID = "ID" Public Const GB_C_SUBJECTS = "subjects" 'Public Const GB_C_CATEGORY = "category" 'Public Const GB_C_TIMES = "times" Public Const GB_T_LAW_INFO_TABLE = "law_info_table" Public Const GB_T_FILL_WORD_TABLE = "fill_word_table" Public Const GB_T_TEMPORARY_TABLE = "temporary_table" Public Const GB_T_NUMBER_TABLE = "number_table" Public Const GB_T_QUESTION_CYCLE_TABLE = "question_cycle_table" Sub create_fill_in_the_blank_character() '選択した文字列を穴埋め形式にする(文字列を[]で囲む) '[]で囲まれた文字が穴埋め文字列となり、呼び出されたときに解釈される Dim rng As Range Set rng = Selection ' Debug.Print (c.Value) Dim i As Long Dim str As Variant Application.DisplayAlerts = False For i = 1 To rng.Count str = str & rng.Item(i) Next i '①一列挿入 Range(rng.Item(1).Address(False, False)).Insert shift:=xlShiftToRight 'Debug.Print rng.Item(1).Address(False, False) '②①で挿入した列に識別文字を挿入 Range(Range(rng.Item(1).Address(False, False)).Offset(0, -1).Address(False, False)).Value = "[" Range(Range(rng.Item(rng.Count).Address(False, False)).Offset(0, 1).Address(False, False)).Insert shift:=xlShiftToRight Range(Range(rng.Item(rng.Count).Address(False, False)).Offset(0, 1).Address(False, False)).Value = "]" 'Debug.Print rng.Item(rng.Count).Address(False, False) '以下マージを行う ' Range(rng.Item(1).Address(False, False) & ":" & rng.Item(rng.Count).Address(False, False)).Merge ' ' Range(rng.Item(1).Address(False, False)).Value = str Application.DisplayAlerts = True End Sub Sub row_insert_1() '選択したセルに一列追加 Application.ScreenUpdating = False Dim rng As Range Set rng = Selection Dim i As Long For i = 1 To rng.Count ' Debug.Print i & ":" & rng.Item(i).Address(False, False) Range(rng.Item(i).Address(False, False)).Insert shift:=xlShiftToRight Next i Application.ScreenUpdating = True End Sub Sub row_delete_1() '選択したセルを1列削除 Application.ScreenUpdating = False Dim rng As Range Set rng = Selection Dim i As Long ' For i = 1 To rng.Count ' ' Debug.Print i & ":" & rng.Item(i).Address(False, False) ' ' Range(rng.Item(i).Address(False, False)).Delete (xlShiftToLeft) ' ' Next i '減少カウンタを使う理由 'https://teratail.com/questions/75463 For i = rng.Count To 1 Step -1 Range(rng.Item(i).Address(False, False)).Delete (xlShiftToLeft) Next i Application.ScreenUpdating = True End Sub Sub drow_line() '選択したセルの外側に罫線を引く Application.ScreenUpdating = False Dim rng As Range Set rng = Selection Dim bs As Border Set bs = rng.Borders(xlEdgeTop) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeBottom) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeLeft) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeRight) bs.LineStyle = xlContinuous End Sub Sub drow_line2() '選択したセルの外側に罫線を引く '水平線も引く Application.ScreenUpdating = False Dim rng As Range Set rng = Selection Dim bs As Border Set bs = rng.Borders(xlEdgeTop) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeBottom) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeLeft) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlEdgeRight) bs.LineStyle = xlContinuous Set bs = rng.Borders(xlInsideHorizontal) bs.LineStyle = xlContinuous End Sub Sub delete_line() '選択したセルの罫線を削除する Application.ScreenUpdating = False Dim rng As Range Set rng = Selection rng.Borders.LineStyle = xlLineStyleNone End Sub Function rgist_fill_question(mode As Long) 'mode1:通常登録 'mode2:編集登録存在チェックを行わない Dim newBookName As String Dim savepath As String Dim newBook As Workbook Dim sheetname As String Dim id As Long Dim licence_chara As String Dim category_chara As String Dim no_chara As String Dim row As Long Dim col As Long Dim t_rate As Long Dim summary As String Dim dic_obj_select_info As Object Dim select_dto As Object Dim tbList As ListObject If mode = 1 Then licence_chara = regist_Form.licence_ComboBox.Value category_chara = regist_Form.category_ComboBox.Value no_chara = regist_Form.no_TextBox row = regist_Form.row_TextBox col = regist_Form.col_TextBox sheetname = licence_chara & "_" & category_chara & "_" & no_chara t_rate = regist_Form.rate_ComboBox.ListIndex summary = regist_Form.summary_TextBox '-------------情報登録------------- Set dic_obj_select_info = CreateObject("Scripting.Dictionary") '存在チェックを行う dic_obj_select_info.Add GB_LICENCE, licence_chara dic_obj_select_info.Add GB_CATEGORY, category_chara dic_obj_select_info.Add GB_NUM, no_chara ' dic_obj_select_info.Add GB_RATE, t_rate ' dic_obj_search_info.Add GB_SUMMARY, summary Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map) If select_dto.Count > 0 Then MsgBox "登録済みの問題です。" End End If '情報登録を行う Dim dic_obj_insert_info As Object Set dic_obj_insert_info = CreateObject("Scripting.Dictionary") Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE) dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1 dic_obj_insert_info.Add GB_LICENCE, licence_chara dic_obj_insert_info.Add GB_CATEGORY, category_chara dic_obj_insert_info.Add GB_NUM, no_chara dic_obj_insert_info.Add GB_ROW, row dic_obj_insert_info.Add GB_COL, col dic_obj_insert_info.Add GB_RATE, t_rate dic_obj_insert_info.Add GB_SUMMARY, summary dic_obj_insert_info.Add GB_DEL_FLG, 0 Call insert_info(GB_T_LAW_INFO_TABLE, dic_obj_insert_info, law_info_table_map) End If If mode = 2 Then Set dic_obj_select_info = CreateObject("Scripting.Dictionary") 'テンポラリーテーブルから更新用のIDを取得 dic_obj_select_info.Add GB_T_ID, 1 Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map) id = select_dto.Item(1).Item(GB_ID) licence_chara = select_dto.Item(1).Item(GB_LICENCE) category_chara = select_dto.Item(1).Item(GB_CATEGORY) no_chara = select_dto.Item(1).Item(GB_NUM) sheetname = licence_chara & "_" & category_chara & "_" & no_chara t_rate = edit_Form.rate_ComboBox.ListIndex summary = edit_Form.summary_TextBox '行列の更新を行う row = edit_Form.row_TextBox col = edit_Form.col_TextBox '更新条件用の入れ物を用意 Dim dic_obj_search_info As Object Set dic_obj_search_info = CreateObject("Scripting.Dictionary") dic_obj_search_info.Add GB_ID, id '更新値用の入れ物を用意 Dim dic_obj_update_info As Object Set dic_obj_update_info = CreateObject("Scripting.Dictionary") dic_obj_update_info.Add GB_ROW, row dic_obj_update_info.Add GB_COL, col dic_obj_update_info.Add GB_RATE, t_rate dic_obj_update_info.Add GB_SUMMARY, summary '更新処理を行う Call update_info(GB_T_LAW_INFO_TABLE, dic_obj_search_info, dic_obj_update_info, law_info_table_map) End If '-------------問題ブック作成------------- Application.DisplayAlerts = False Application.ScreenUpdating = False 'ブック作成 newBookName = no_chara & ".xlsx" savepath = ThisWorkbook.path & "\" & licence_chara & "\" & category_chara & "\" & newBookName ' Debug.Print savepath Call DeleteSomething Set newBook = Workbooks.Add ThisWorkbook.Activate If mode = 1 Then ThisWorkbook.Worksheets("問題作成").Copy after:=newBook.Sheets(newBook.Sheets.Count) ElseIf mode = 2 Then ThisWorkbook.Worksheets("編集").Copy after:=newBook.Sheets(newBook.Sheets.Count) End If newBook.Activate '1枚目のシート以外は削除する Dim i As Long For i = 1 To Worksheets.Count - 1 newBook.Sheets(i).Delete Next i ' newBook.Sheets("Sheet1").Delete ' newBook.Sheets("Sheet2").Delete ' newBook.Sheets("Sheet3").Delete 'シート名を変更 newBook.Sheets(1).Name = sheetname '不要な行の削除 ' Range("A2", Cells(Rows.Count, 1).End(xlUp)).EntireRow.Delete '不要なフォームボタンの削除 Dim myShape As Variant If Worksheets(sheetname).Shapes.Count > 0 Then For Each myShape In Worksheets(sheetname).Shapes '図形がフォームボタンなら削除 If myShape.Type = msoFormControl Then myShape.Delete End If Next End If newBook.SaveAs savepath newBook.Close False Set newBook = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "登録完了です。" regist_Form.no_TextBox = "" regist_Form.row_TextBox = "" regist_Form.col_TextBox = "" law_Form.law_TextBox = "" Cells(4, 4).Select End Function Sub open_law_Form() law_Form.Show vbModeless End Sub Sub open_regist_form() regist_Form.Show vbModeless End Sub Sub open_fill_chara_form() fill_chara_Form.Show vbModeless End Sub Sub reset_question() Dim rc As Integer Dim myShape As Variant rc = MsgBox("リセットしますか?", vbYesNo + vbQuestion, "確認") If rc = vbYes Then 'A3行以下、文字、図形を削除 Call delete_all("A3", "問題作成") ' Range("A3", Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete ' ' ' If ThisWorkbook.Worksheets("問題作成").Shapes.Count > 0 Then ' ' For Each myShape In question_Book.Worksheets(1).Shapes ' ' myShape.Delete ' ' Next ' ' End If Else MsgBox "処理を中断します" End If End Sub Function delete_all(delete_row_range As String, sheet_name As String) '第一引数:ここで指定した行以下を削除 例 "A3" '第二引数:削除を行いたいシート名を指定 Dim myShape As Variant '文字情報を削除する Range(delete_row_range, Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete '画像情報を削除する If ThisWorkbook.Worksheets(sheet_name).Shapes.Count > 0 Then For Each myShape In Worksheets(sheet_name).Shapes 'フォームボタンは消さない If myShape.Type <> msoFormControl Then myShape.Delete End If 'フォームボタンの削除について 'https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1155987826 ' If myShape.FormControlType <> xlButtonControl Then ' ' myShape.Delete ' ' End If Next End If End Function Sub test() '情報登録 Dim dic_obj_select_info As Object Set dic_obj_select_info = CreateObject("Scripting.Dictionary") Dim select_dto As Object '存在チェック dic_obj_select_info.Add GB_LICENCE, "電験三種" dic_obj_select_info.Add GB_CATEGORY, "電技解釈" dic_obj_select_info.Add GB_NUM, 1 Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map) Debug.Print select_dto.Item(GB_ROW) End Sub Sub test_regist() Dim dic_obj_insert_info As Object Set dic_obj_insert_info = CreateObject("Scripting.Dictionary") Dim tbList As ListObject Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE) dic_obj_insert_info.Add GB_LICENCE, "電験三種" dic_obj_insert_info.Add GB_CATEGORY, "電技解釈" dic_obj_insert_info.Add GB_NUM, "10" dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1 Call insert_info(GB_T_LAW_INFO_TABLE, dic_obj_insert_info, law_info_table_map) End Sub Sub test_update() Dim dic_obj_update_info As Object Set dic_obj_update_info = CreateObject("Scripting.Dictionary") Dim dic_obj_search_info As Object Set dic_obj_search_info = CreateObject("Scripting.Dictionary") '検索条件 dic_obj_search_info.Add GB_CATEGORY, "電技解釈" ' dic_obj_search_info.Add GB_ID, 3 '更新値 dic_obj_update_info.Add GB_NUM, 40 dic_obj_update_info.Add GB_ROW, 90 Call update_info(GB_T_LAW_INFO_TABLE, dic_obj_search_info, dic_obj_update_info, law_info_table_map) End Sub Sub decompose_string_direct(str) '入力された文字列をセルに1文字ずつ入れていく Dim i As Long Dim row As Long Dim col As Long row = 0 col = 1 Application.ScreenUpdating = False '前の文字 Dim current_char As String With ActiveCell ' str = .Value For i = 1 To Len(str) current_char = Mid(str, i, 1) If current_char = "/" Then row = row + 1 col = 1 Else .Offset(row, col).Value = current_char col = col + 1 End If Next i End With Application.ScreenUpdating = True End Sub Function DeleteSomething() 'シートコピー前のおまじない '何を消してるんだろう? Dim C As Name For Each C In Names C.Delete Next End Function Sub セルに入力された文字列を一文字ずつ横方向に分解する() '使ってない Dim str As String Dim i As Long Dim row As Long Dim col As Long row = 0 col = 1 Dim length_linefeed_chara '改行文字数 length_linefeed_chara = 30 Dim linefeed_count As Long '改行を行った回数 linefeed_count = 0 Dim punctuation_mark_flg As Boolean '句読点フラグ punctuation_mark_flg = False Dim blank_chara_start As String '穴埋め文字が始まるのを判別する文字 blank_chara_start = "[" Dim blank_chara_end As String '穴埋め文字が終わるのを判別する文字 blank_chara_end = "]" Dim fill_in_the_blank_chara As String Dim fill_in_the_blank_chara_count As Long Dim merge_start As String Dim merge_end As String Dim fill_in_the_blank_flg '穴埋めフラグ 当フラグがONの場合は改行しない fill_in_the_blank_flg = False Dim pre_char As String '前の文字 Dim current_char As String '今の文字 Dim next_char As String '次の文字 Dim active_address_char As String With ActiveCell str = .Value For i = 1 To Len(str) punctuation_mark_flg = False current_char = Mid(str, i, 1) If i > 1 Then pre_char = Mid(str, i - 1, 1) next_char = Mid(str, i + 1, 1) If current_char = blank_chara_start Then fill_in_the_blank_flg = True 'ディクショナリを宣言 Dim dictionary_object_coordinate As Object Set dictionary_object_coordinate = CreateObject("Scripting.Dictionary") fill_in_the_blank_chara_count = 1 End If If fill_in_the_blank_flg = True And current_char = blank_chara_end Then fill_in_the_blank_flg = False End If '穴埋めの文字列の間は改行しない If fill_in_the_blank_flg = False Then 'イロハニ問答無用で改行 If current_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ,ル]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If '漢数字ニ桁で改行 If current_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) And pre_char Like "[一,ニ,三,四,五,六,七,八,九,十]" Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If '漢数字一桁で改行 If current_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If If (i > length_linefeed_chara And Not current_char Like "[あ-ん]") And pre_char Like "[あ-ん]" Then .Offset(1, 0).Select row = row + 1 col = 1 If current_char = "、" Or current_char = "。" Then punctuation_mark_flg = True End If length_linefeed_chara = i + 30 End If End If End If next_loop: If punctuation_mark_flg = False Then .Offset(row, col).Value = current_char If fill_in_the_blank_flg = True Then fill_in_the_blank_chara = fill_in_the_blank_chara + current_char ' Debug.Print .Offset(row, col).Address(RowAbsolute:=False, ColumnAbsolute:=False) 'ディクショナリに文字座標をブッ込んでいく dictionary_object_coordinate.Add fill_in_the_blank_chara_count, .Offset(row, col).Address(RowAbsolute:=False, ColumnAbsolute:=False) fill_in_the_blank_chara_count = fill_in_the_blank_chara_count + 1 End If 'current_charが"]"だったら、各種処理を行う '穴埋めセルの結合 '穴埋め文字始めの座標の登録 '穴埋め文字の登録 'ジャンル(ID、電験三種、電気事業法、一条、予備、予備)座標、穴埋め文字列をセットで登録する '一条までは共通、以下座標ごとに個別 If current_char = blank_chara_end Then merge_start = dictionary_object_coordinate.Item(2) merge_end = .Offset(row, col - 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) Worksheets("問題展開").Range(merge_start & ":" & merge_end).Merge Range(dictionary_object_coordinate.Item(2)).Value = Mid(fill_in_the_blank_chara, 2) merge_start = "" merge_end = "" End If col = col + 1 End If Next i End With Debug.Print Mid(fill_in_the_blank_chara, 2) End Sub Sub pattern_test() '使用していない Dim str As String ' str = "ニ" ' ' If str Like "[イ,ロ,ハ,ニ]" Then ' ' Debug.Print str ' ' End If str = "小売供給 一般の需要に" If InStr(str, "") Then Debug.Print "全角スペースだぜ" End If End Sub Sub merge_cells() '使用していない Dim a As String Dim b As String Dim str As String Range("A1").Select a = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) Worksheets("Sheet1").Range(a & ":B1").Merge End Sub Function get_kanji(str As String) '使用していない Dim kanji_flg As Boolean kanji_flg = False Dim kanji As String Set reg = CreateObject("VBScript.RegExp") reg.Pattern = "[一-龠〃々〆〇]" For i = 1 To Len(str) current_char = Mid(str, i, 1) If reg.test(current_char) Then kanji_flg = True End If If reg.test(current_char) = False Then kanji_flg = False End If If kanji_flg = True Then kanji = kanji + current_char End If If kanji_flg = False Then If Len(kanji) > 1 Then Debug.Print kanji End If kanji = "" End If Next i End Function Sub decompose_string(str) '使用していません ' Dim str As String Dim i As Long Dim row As Long Dim col As Long row = 0 col = 1 Dim reg As Object Set reg = CreateObject("VBScript.RegExp") reg.Pattern = "[一-龠〃々〆〇]" Dim length_linefeed_chara '改行文字数 length_linefeed_chara = 30 Dim linefeed_count As Long '改行を行った回数 linefeed_count = 0 Dim punctuation_mark_flg As Boolean '句読点フラグ punctuation_mark_flg = False Dim blank_chara_start As String '穴埋め文字が始まるのを判別する文字 blank_chara_start = "[" Dim blank_chara_end As String '穴埋め文字が終わるのを判別する文字 blank_chara_end = "]" Dim fill_in_the_blank_chara As String Dim fill_in_the_blank_chara_count As Long Dim merge_start As String Dim merge_end As String Dim fill_in_the_blank_flg '穴埋めフラグ 当フラグがONの場合は改行しない fill_in_the_blank_flg = False Dim pre_char As String '前の文字 Dim current_char As String '今の文字 Dim next_char As String '次の文字 Dim next_next_char As String '次の次の文字 '次の次の次の文字 Dim next_next_next_char As String Dim active_address_char As String With ActiveCell ' str = .Value For i = 1 To Len(str) punctuation_mark_flg = False current_char = Mid(str, i, 1) If i > 1 Then pre_char = Mid(str, i - 1, 1) next_char = Mid(str, i + 1, 1) next_next_char = Mid(str, i + 2, 1) next_next_next_char = Mid(str, i + 3, 1) '穴埋めの文字列の間は改行しない If fill_in_the_blank_flg = False Then 'イロハニ問答無用で改行 If current_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then .Offset(1, 0).Select row = row + 1 col = 2 length_linefeed_chara = i + 30 GoTo next_loop End If '漢数字三桁で改行 If current_char Like "[一,二,三,四,五,六,七,八,九]" And next_char Like "[十]" And next_next_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If '漢数字ニ桁で改行 If current_char Like "[一,二,三,四,五,六,七,八,九,十]" And next_char Like "[一,二,三,四,五,六,七,八,九,十]" And (InStr(next_next_char, " ") = 1 Or InStr(next_next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If '漢数字一桁で改行 If current_char Like "[一,二,三,四,五,六,七,八,九,十]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then .Offset(1, 0).Select row = row + 1 col = 1 length_linefeed_chara = i + 30 GoTo next_loop End If '(イロハニ)で改行 If current_char = "(" And next_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ]" And next_next_char = ")" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) Then .Offset(1, 0).Select row = row + 1 col = 2 length_linefeed_chara = i + 30 GoTo next_loop End If '(123456789)で改行 If current_char = "(" And next_char Like "[1,2,3,4,5,6,7,8,9]" And next_next_char = ")" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) Then .Offset(1, 0).Select row = row + 1 col = 2 length_linefeed_chara = i + 30 GoTo next_loop End If If i > length_linefeed_chara And (pre_char = "、" Or pre_char = "。") Then .Offset(1, 0).Select row = row + 1 col = 2 length_linefeed_chara = i + 30 End If If i > length_linefeed_chara And current_char Like "[あ-ん]" Then .Offset(1, 0).Select row = row + 1 col = 2 length_linefeed_chara = i + 30 End If End If End If next_loop: .Offset(row, col).Value = current_char If current_char <> "" Then col = col + 1 End If Next i End With End Sub Sub get_keisen() Dim bs As Borders Set bs = Range("D16", "AN20").Borders Debug.Print (bs.LineStyle) Debug.Print (bs.Weight) End Sub ●module2 Option Explicit Sub select_question() 'ランダムで選ばれたブックを開く Dim id As Long Dim select_dto As Object Dim tbList As ListObject Application.DisplayAlerts = False Application.ScreenUpdating = False '------------------------超手抜き 連番で攻略したいの Dim setter_number As Object Dim getter_number As Object Dim sequence_flg As Boolean Dim setter_number_update As Object sequence_flg = False Dim sequence_num As Long Set setter_number = CreateObject("Scripting.Dictionary") setter_number.Add GB_T_ID, 1 Set getter_number = select_info(GB_T_NUMBER_TABLE, setter_number, number_table_map) Debug.Print getter_number.Item(1).Item(GB_NUMBER1) 'number_tableの値を0にしておけばランダム出題になる If getter_number.Item(1).Item(GB_NUMBER1) > 0 Then id = getter_number.Item(1).Item(GB_NUMBER1) sequence_num = getter_number.Item(1).Item(GB_NUMBER1) '連番でやる意欲を感じるぜ sequence_flg = True Set setter_number = Nothing Set getter_number = Nothing Else 'ランダム出題 '------------------------law_info_tableから問題呼び出し-------------------------- '------------------------------------------- ' Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE) ' Randomize '乱数系列初期化 ' id = Int(tbList.ListRows.Count * Rnd + 1) '------------------------------------------- 'idをサイクルで取得する Dim obj_subjects As Object '科目を決められたサイクルで選び出す Set obj_subjects = selectSubjects() id = returnRndIdWithCategory(obj_subjects) End If '問題情報を各ブックから取得し演習シートにコピペ Set select_dto = get_question(id, "演習") '------------------------temporaryテーブルに問題の情報登録-------------------------- Set tbList = Worksheets(GB_T_TEMPORARY_TABLE).ListObjects(GB_T_TEMPORARY_TABLE) '既存情報削除(レコードがない状態で行うとエラー) If tbList.ListRows.Count > 0 Then tbList.DataBodyRange.Delete End If '現在展開している問題の把握のため 問題の穴埋め箇所の更新等に利用 Dim dic_obj_insert_info As Object Set dic_obj_insert_info = CreateObject("Scripting.Dictionary") dic_obj_insert_info.Add GB_T_ID, 1 dic_obj_insert_info.Add GB_ID, select_dto.Item(1).Item(GB_ID) dic_obj_insert_info.Add GB_LICENCE, select_dto.Item(1).Item(GB_LICENCE) dic_obj_insert_info.Add GB_CATEGORY, select_dto.Item(1).Item(GB_CATEGORY) dic_obj_insert_info.Add GB_NUM, select_dto.Item(1).Item(GB_NUM) dic_obj_insert_info.Add GB_ROW, select_dto.Item(1).Item(GB_ROW) dic_obj_insert_info.Add GB_COL, select_dto.Item(1).Item(GB_COL) dic_obj_insert_info.Add GB_RATE, select_dto.Item(1).Item(GB_RATE) dic_obj_insert_info.Add GB_SUMMARY, select_dto.Item(1).Item(GB_SUMMARY) dic_obj_insert_info.Add GB_TEXT, select_dto.Item(1).Item(GB_TEXT) Call insert_info(GB_T_TEMPORARY_TABLE, dic_obj_insert_info, temporary_table_map) '------------------------問題解析-------------------------- Sheets("演習").Activate Call register_fill_in_the_blank_character(select_dto.Item(1).Item(GB_ROW), select_dto.Item(1).Item(GB_COL)) Range("T2").Value = select_dto.Item(1).Item(GB_CATEGORY) Set setter_number = CreateDictionary Set setter_number_update = CreateDictionary '連番で解答したいの If sequence_flg = True Then 'カウントアップ sequence_num = sequence_num + 1 setter_number.Add (GB_T_ID), 1 setter_number_update.Add (GB_NUMBER1), sequence_num Call update_info(GB_T_NUMBER_TABLE, setter_number, setter_number_update, number_table_map) sequence_flg = False End If Dim times As Long times = select_dto.Item(1).Item(GB_C_TIMES) 'サイクル用に解答回数+1 Dim setter_target As Object Dim setter_value As Object Set setter_target = CreateDictionary Set setter_value = CreateDictionary setter_target.Add GB_ID, id setter_value.Add GB_C_TIMES, times + 1 Call update_info(GB_T_LAW_INFO_TABLE, setter_target, setter_value, law_info_table_map) 'サイクルカウントアップ Call updateCycleNO Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function register_fill_in_the_blank_character(last_row As Long, last_col As Long) '[]でくくられている文字とセル座標を取得し登録する Dim tbList As ListObject Set tbList = Worksheets(GB_T_FILL_WORD_TABLE).ListObjects(GB_T_FILL_WORD_TABLE) '既存情報削除(レコードがない状態で行うとエラー) If tbList.ListRows.Count > 0 Then tbList.DataBodyRange.Delete End If Dim i As Long Dim j As Long Dim fill_flg As Boolean Dim start_address As String Dim str As String fill_flg = False For i = 1 To last_row For j = 1 To last_col If fill_flg = True Then 'Debug.Print Cells(i, j).Value str = str & Cells(i, j).Value End If If Cells(i, j).Value = "[" Then start_address = Cells(i, j + 1).Address(False, False) fill_flg = True End If If Cells(i, j + 1).Value = "]" Then Range(start_address & ":" & Cells(i, j).Address(False, False)).Merge Range(start_address).Value = "" Range(start_address).Interior.ColorIndex = 19 Dim dic_obj_insert_info As Object Set dic_obj_insert_info = CreateObject("Scripting.Dictionary") dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1 dic_obj_insert_info.Add GB_PLACE, start_address dic_obj_insert_info.Add GB_WORD, str Call insert_info(GB_T_FILL_WORD_TABLE, dic_obj_insert_info, fill_word_table_map) start_address = "" str = "" fill_flg = False End If Next j Next i End Function Sub edit_question() '問題の編集を行う 'temporaryから問題情報取得 '問題作成シートに展開 Dim select_dto As Object Dim question_info_dto As Object Dim dic_obj_select_info As Object Set dic_obj_select_info = CreateObject("Scripting.Dictionary") '------------------------temporary_table-------------------------- '一時テーブルから現在展開されている問題情報を取得する dic_obj_select_info.Add GB_T_ID, 1 Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map) '初期化 Set dic_obj_select_info = CreateObject("Scripting.Dictionary") '------------------------law_info_table------------------------- 'law_info_tableから情報を取得する dic_obj_select_info.Add GB_ID, select_dto.Item(1).Item(GB_ID) Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map) '問題を呼び出す Set question_info_dto = get_question(select_dto.Item(1).Item(GB_ID), "編集") ThisWorkbook.Save Set question_info_dto = Nothing End Sub Function get_question(id As Long, sheet_name As String) As Object '問題を呼び出す関数 '第一引数 id '第二引数 呼び出した問題を展開するシート名 '呼ばれるタイミング Dim question_Book As Workbook Dim licence_chara As String Dim category_chara As String Dim question_path As String Dim num As Variant Dim row As Long Dim col As Long Dim select_dto As Object Dim dic_obj_select_info As Object Set dic_obj_select_info = CreateObject("Scripting.Dictionary") Application.DisplayAlerts = False Application.ScreenUpdating = False Worksheets(sheet_name).Activate '既存削除 ' Worksheets(sheet_name).Range("A3", Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete Call delete_all("A3", sheet_name) dic_obj_select_info.Add GB_ID, id Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map) licence_chara = select_dto.Item(1).Item(GB_LICENCE) category_chara = select_dto.Item(1).Item(GB_CATEGORY) num = select_dto.Item(1).Item(GB_NUM) row = select_dto.Item(1).Item(GB_ROW) col = select_dto.Item(1).Item(GB_COL) question_path = ThisWorkbook.path & "\" & licence_chara & "\" & category_chara & "\" & num Set question_Book = Workbooks.Open(question_path, 3) '文字情報の貼り付け question_Book.Worksheets(1).Range(Cells(3, 1), Cells(row, col)).Copy ThisWorkbook.Activate Worksheets(sheet_name).Cells(3, 1).PasteSpecial xlPasteAll '画像情報の貼り付け '穴埋め問題ジェネレーター.xlsmの演習シートが選択されている Dim myShape As Variant If question_Book.Worksheets(1).Shapes.Count > 0 Then For Each myShape In question_Book.Worksheets(1).Shapes myShape.Copy ActiveSheet.Paste 'myShape.Top+30等で貼り付ける位置を調整できる Selection.Top = myShape.Top Selection.Left = myShape.Left Next End If Worksheets(sheet_name).Activate Worksheets(sheet_name).Cells(3, 1).Select 'ThisWorkbook.Save question_Book.Close savechanges:=False Application.DisplayAlerts = False Application.ScreenUpdating = False Set get_question = select_dto End Function Sub open_edit_form() Dim select_dto As Object Dim dic_obj_select_info As Object Set dic_obj_select_info = CreateObject("Scripting.Dictionary") Dim t_rate As Long dic_obj_select_info.Add GB_T_ID, 1 Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map) ' Debug.Print select_dto.Item(1).Item(GB_LICENCE) edit_Form.licence_TextBox = select_dto.Item(1).Item(GB_LICENCE) edit_Form.category_TextBox = select_dto.Item(1).Item(GB_CATEGORY) edit_Form.no_TextBox = select_dto.Item(1).Item(GB_NUM) edit_Form.row_TextBox = select_dto.Item(1).Item(GB_ROW) edit_Form.col_TextBox = select_dto.Item(1).Item(GB_COL) edit_Form.rate_ComboBox.ListIndex = select_dto.Item(1).Item(GB_RATE) edit_Form.summary_TextBox = select_dto.Item(1).Item(GB_SUMMARY) edit_Form.text_TextBox = select_dto.Item(1).Item(GB_TEXT) edit_Form.licence_TextBox.Enabled = False edit_Form.category_TextBox.Enabled = False edit_Form.no_TextBox.Enabled = False edit_Form.Show vbModeless End Sub Sub open_text() '---------------------temporary_tableからテキストページを取得 Dim text_page As Long Dim setter As Object Dim getter As Object Set setter = CreateObject("Scripting.Dictionary") Set getter = CreateObject("Scripting.Dictionary") setter.Add GB_T_ID, 1 Set getter = select_info(GB_T_TEMPORARY_TABLE, setter, temporary_table_map) text_page = getter.Item(1).Item(GB_TEXT) Dim path As String Dim xClip Set xClip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'クリップボードに開きたいPDFのページ数をコピー xClip.SetText text_page xClip.PutInClipboard 'まさかの決め打ち path = ThisWorkbook.path & "\電験三種\テキスト\電験三種のエロ本応用編.pdf" 'pdfファイルを開く With CreateObject("Wscript.Shell") .Run path, 5 End With With Application .Wait Now + TimeValue("00:00:01") .SendKeys "^+N", True 'CTRL+SHIF+Nを押す .Wait Now + TimeValue("00:00:01") .SendKeys "^v", True 'CTRL+Vを押す .SendKeys "~", True 'エンターを押す End With End Sub Function selectSubjects() As Object '決められたサイクルで科目名を返却する 'サイクル番号はnumber_tableのcycle_noを使う Dim setter As Object Dim getter_subjects As Object Dim getter_cycle_no As Object Dim i As Long Dim dto_subjects Set dto_subjects = CreateDictionary Set setter = CreateDictionary 'サイクルリストの条件 setter.Add GB_ID, "*" 'サイクルリストを取得する Set getter_subjects = select_info(GB_T_QUESTION_CYCLE_TABLE, setter, question_cycle_table_map) Set setter = Nothing Set setter = CreateDictionary ' Debug.Print "selectSubjects.getter_subjects" & getter_subjects.Count setter.Add GB_T_ID, 1 '現在のサイクル番号を取得する Set getter_cycle_no = select_info(GB_T_NUMBER_TABLE, setter, number_table_map) ' Debug.Print "selectSubjects.getter_cycle_no" & getter_cycle_no.Count For i = 1 To getter_subjects.Count If getter_subjects.Item(i).Item(GB_C_ID) = getter_cycle_no.Item(1).Item(GB_NUMBER2) Then dto_subjects.Add GB_LICENCE, getter_subjects.Item(i).Item(GB_LICENCE) dto_subjects.Add GB_C_SUB_CATEGORY, getter_subjects.Item(i).Item(GB_C_SUB_CATEGORY) dto_subjects.Add GB_C_TIMES, getter_subjects.Item(i).Item(GB_C_TIMES) ' Debug.Print "資格" & getter_subjects.Item(i).Item(GB_LICENCE) ' Debug.Print "カテゴリ" & getter_subjects.Item(i).Item(GB_C_SUB_CATEGORY) ' Debug.Print "回数" & getter_subjects.Item(i).Item(GB_C_TIMES) Exit For End If Next i Set selectSubjects = dto_subjects End Function Function updateCycleNO() '今のサイクルNOをカウントアップする 'サイクル番号はmemory_tableのslot1を使う Dim cycleNo As Long Dim setter As Object Dim setter_target As Object Dim setter_value As Object Dim getter_subjects As Object Dim getter_cycle_no As Object Set setter = CreateDictionary Set setter_target = CreateDictionary Set setter_value = CreateDictionary setter.Add GB_ID, "*" 'サイクルリストを取得する Set getter_subjects = select_info(GB_T_QUESTION_CYCLE_TABLE, setter, question_cycle_table_map) Debug.Print getter_subjects.Count Set setter = Nothing Set setter = CreateDictionary setter.Add GB_T_ID, 1 '現在のサイクル番号を取得する Set getter_cycle_no = select_info(GB_T_NUMBER_TABLE, setter, number_table_map) If getter_cycle_no.Item(1).Item(GB_NUMBER2) < getter_subjects.Count Then cycleNo = getter_cycle_no.Item(1).Item(GB_NUMBER2) + 1 setter_target.Add GB_T_ID, 1 setter_value.Add GB_NUMBER2, cycleNo Else cycleNo = 1 setter_target.Add GB_T_ID, 1 setter_value.Add GB_NUMBER2, cycleNo End If Call update_info(GB_T_NUMBER_TABLE, setter_target, setter_value, number_table_map) End Function Function returnRndIdWithCategory(subjects As Object) As Long '選択科目の問題からランダムにIDを返却する Dim setter As Object Dim getter As Object Set setter = CreateDictionary '資格名を設定する setter.Add GB_LICENCE, subjects.Item(GB_LICENCE) ' Debug.Print "◇名" & subjects.Item(GB_LICENCE) 'カテゴリーが設定されていたら、条件に追加する If subjects.Item(GB_C_SUB_CATEGORY) <> "" Then setter.Add GB_C_SUB_CATEGORY, subjects.Item(GB_C_SUB_CATEGORY) End If ' Debug.Print "カテゴリ" & subjects.Item(GB_C_SUB_CATEGORY) '回数が設定されていたら 未出題に限定したいとき If subjects.Item(GB_C_TIMES) <> "" Then setter.Add GB_C_TIMES, subjects.Item(GB_C_TIMES) End If ' MsgBox subjects.Item(GB_C_TIMES) Set getter = select_info(GB_T_LAW_INFO_TABLE, setter, law_info_table_map) If getter.Count = 0 Then MsgBox "サイクルモードで科目または、カテゴリー設定に誤りがあります" End End If ' Debug.Print "カウント" & getter.Count 'ランダム番号を取得する Dim randomNumber As Long Randomize randomNumber = Int(getter.Count * Rnd) + 1 ' Debug.Print randomNumber returnRndIdWithCategory = getter.Item(randomNumber).Item(GB_C_ID) End Function Sub randtest() Dim tbList As ListObject Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE) Randomize '乱数系列初期化 Debug.Print Int(tbList.ListRows.Count * Rnd + 1) '1~6で乱数生成 End Sub Sub longtest() Dim a As Long Dim b As Long If IsEmpty(a) Then Debug.Print "なんもないよ" Else Debug.Print a End If End Sub Sub cycle_test() Dim setter As Object Dim getter As Object Set setter = CreateDictionary setter.Add GB_LICENCE, "消防4類乙" Set getter = select_info(GB_T_LAW_INFO_TABLE, setter, law_info_table_map) Debug.Print getter.Count Debug.Print getter.Count End Sub ●各ボタン ★問題作成シート 問題作成:open_law_form 穴埋め:open_fill_chara_form 問題登録:open_regist_form リセット:reset_question ★演習シート 問題ガチャ:select_question 編集:edit_question テキスト:open_text ★編集シート 問題作成:open_law_form 穴埋め:open_fill_chara_form 再登録する:open_edit_form 問題ガチャ:select_question テキスト:open_text
パチンコに思うこと
コロナ真っ盛りですが、叩かれてますねパチンカー
自粛正義チームサイドにとっては良いカモですな。
私はパチンコには興味はないですが、ネットの投書欄を見ていると
そこまで言わんでエエやろと思ってます。
さて、StayHomeを実行している皆さん、自宅待機が始まって、
数日間は日々の過酷な労役からの解放感がハンパなかったと思います。
そろそろやることなくなってきてませんか。
どうですかー実際のところ。
回答①「ソンナコトナイヨー、シュミニボットウデキテサイコー」
はい①さん、あなた、あなたは三国一の幸せ者です。
回答②「うーん、そろそろやることなくなってきた、クソみたいな満員電車がなつい」
はい②さん、リリー・フランキーさんも言ってました、
仕事はヒマを潰すためににあると。
回答③「ジャンジャンバリバリ」
あー、さては③さん、3密MAXの所にいるでしょ。
壇蜜さんに蔑んだ目で見て欲しいの?そーいう趣味なの?
おそらく、②の人が多数で、①の人はごく少数なのではないでしょうか。
そして、②の人が感じているヒマヒマ感が、パチンカーの人が普段感じている
感覚なのではないでしょうか。
やることがない・・・
刺激がない・・・
あー、マズイ、マズイよあいつが出てくる。
バーン(扉を蹴破って入ってくる)
脳「おやおや、刺激の供出が遅れているようですが、早くしてもらえませんかね」
体「待ってください、この非常時では娯楽が限られているんです、
私はマインクラフトでラピュタ作るような変態(誉めてますよ)じゃあないんです」
脳「ほーん、じゃあ精神のバランス傾けてみよーかな(ハナホジ)」
体「待ってください、分かりました、ゆ○こから東京都民失格の焼き印を
ケツに押されてもいいので、外に遊びに行きます。ほんと勘弁してください。」
私達人間は頭蓋骨の中に納まっている、ブヨブヨのあいつの奴隷です。
あいつは、常に私達に刺激を要求してきます。
あいつは、私達に静止を許しません、常に運動を求めてきます。
さて、幸せ者の①さん、あなたは脳の良きしもべです。
あなたのステータスの興味の欄には、社会の目的から外れない立派のものが
記入されています。
そして、良い教育に恵まれたのですね、それを見出す機会がちゃんと
あったのですね。そのまま、続けてください。
・・・③の人はぶっちゃけ、ステータスの興味の欄に
悪意としか言えないものが書いてあるのではと
ちょっ、ステフリ(ステータス振り分け)担当の人ちゃんと仕事してーー
または、今の社会の目的にはそぐわないけど、別の社会では
ヒャッハーなのかもしれません。
(ちなみに、今の社会で最強な人の興味の欄には「効率化」と書いてあると思う。)
③「なんだか現世に放りだされたけど、別に望んでねーし、
脳は刺激を求めてくるし、ハァー趣味だってねえし
(興味の欄に「川の石の裏を見るが好き」と書いてある)」
パチンコは③の人の救いになっているではないでしょうか
パチンコの収支はトントンだと聞いています。
勝つときもあれば負ける時もある。
負けているときはクソみたいな気分だけど、勝っているときは天にも昇る気分
そして、謎の石を現金に交換できる。
時間も潰せるし、かなりの差分の刺激が得られる(電圧みたいなイメージ)
最強の価値交換ツール「お金」が手に入ることもある。
③の人、今苦しくてたまらないでしょう。
つまんなくて、つまんなくて、つまんなくて。
それなのに脳から刺激の要求は通常運転で・・・
パチンコは③の人用の療養所みたいなとこなのではないのでしょうか。
普段仕事があるおかけで実は③だというのが露見していない人も
たくさんいるでしょう。
これ以上StayHomeが続くとヒマすぎて精神のバランスを崩す人が
ばんばん出てきて大変なことになりそう。
ドコモの5Gイベントに行ってきました。
5G?
ドコモの5Gイベントに行ってきました。
そして、5Gのすごさは全然実感できませんでした。
通信速度目に見えないしな。くっ。
MR ミックスリアリティ
展示で一番パンチがあったのはMRでした。
あちこちに magic leapの実機があり、体験もできました。
このグラスをつけると、現実の視覚に虚像を重ねることができます。
虚像はあたかも空間に固定されているように見えます。
太陽系の映像を見せてもらいました。
太陽系が目の前に広がっていて、歩いて色んな角度から見てみましたが、
没入感は中々のものでした。
しかし、MRが家庭に降りてくるまでには年単位必要なのではないかと感じました。
magic leapは数年前からかなり話題になっていて、かなり期待していたのですが、
ちょっとがっかりでした。
・映像がカクカク
昔のPCで最新の3Dゲームをプレイした感覚です。
・準備に時間がかかる
体験前に5分くらいの機器調整タイムがありました。
・虚像をうまく操作できない
中央のカメラで人の手の動きを認識して、映し出されている虚像を
操作できる(つまんだり、ボタンを押したり)のですが、
精度が悪いです。
なんだか不穏な記事もありますしね。
IOT
ブログ主はメンテナンス系の仕事をしているので、IOTに興味があります。
現在は、設備の数値取りを人力で行っていますがこれどーにかなんねーかな
と常々思っています。
会場ではLPWAの文字があちこちで踊っていました。
これから人材不足が加速していくでしょうから、いかに人間を歩かせないかが
重要になってくるでしょう。
アナログメーターに取り付けるモジュール。
電源は乾電池。日数回の計測を3年できるみたいですよ、奥さん。
LPWAは小量データ(バイト単位)を小電力で送るもので、5Gとはほぼ関係ないの
ですが、各展示にはかなり力が入っていました。
Face Sharing
これゾクッとしました。
他人の顔の動きを体験できるというものなのです。まだ口だけですが、頬の筋肉を
電気刺激して強制的に動かすというなんだかイケナイ気がするやつです。
この技術が順当に発達していくと、人間そのものを操れるようになるでしょう。
例えば 電気工事なんて一度もやったことのない人を現場にいかせて、
ヘッドセットをかぶせて以下略)なんてことが実現できるようになるかも・・・
そんな世界では人の人材という価値はどーなってしまうのでしょうかね。
危機感
今回のイベントは5Gというより、通信に関係する最新テクノロジーの見本市
みたいなものでした。会場では仕事で来ている感のビジネス人が貪欲に展示を
物色しているが印象的でした。
ブログ主の仕事は最新テクノロジーとは縁遠く、地球ーαケンタウリ間くらいの
距離があります。
しかし、ある日突然導入されたIOTパッケージで仕事を1日で失うという未来が
安易に想像できます。
これからもこーいうイベントには参加して、その日に備えていこうと思います。
アマデウス紅莉栖とおしゃべりしてきました。
国際ロボット展改め「国際ロボットアーム展」に行ってきました
国際ロボットアーム展に行ってきました
毎年年末になると東京ビックサイトで開催されている
国際ロボット展に行ってきました。
ロボット展と名乗っていますが、あるのはほぼロボアームです。
アンドロイドのねーちゃんは見かけませんでした(涙
四方八方ロボアームだらけで最初は正直がっかりしました。
おすすめ巡回順
今回は巡回順がよろしくなかった。
アームロボット展にデートで行く人のためにおすすめ巡回順を教えよう。
巡回順を間違ってロボットアームしかないフロアに最初に行っちゃうと
カノジョ、めぐみん、5秒で飽きてエクスプロージョンだぜ。
え~おほん。
会場は2か所に分かれてます。
ビックサイトと 青海・西・南ホールの2か所です。
今回は時間の関係でビックサイトしか回れませんでした。
なので、ビックサイトのおすすめ巡回順です。
ビックサイトでは西1F、西4F、南1F、南4Fの合計4フロアです。
おすすめの巡回方法は①南4F②南1F③西1F④西4Fです
①はファミリー向けで、VRカヤックとかアシストスーツの試着等
体験型の展示も多めです。
②はYAMAHAや東芝等の誰でも知っているメーカーもあり、展示が華やかです。
コンパニオンのおねーちゃんも増し増しです。
③ロボットアームパラダイスです。みんな大好きDENSOのはんこロボもここです。
④ロボットアームパラダイスその2です。
ご想像の通り①から④にしたがって華やかさが下がって行きます。
私は③④①②と巡回してしまいました。エクスプロージョン。
考えるロボットアーム
展示で一番わくわくしたのが、南1FのMUJINの展示ブースでした。
ロボットアームを工場で使うとなると、ロボットアームの教育が必要なのですが、
これが結構時間がかかる上に、突発的な障害には弱いそうです。
MUJIN社のロボットアームは、自動運転に使われている技術「モーションプランニング」を使って、始点と終点を指定してあげれば自分で考えて最適な動作を自発的に
行うそうです。
ロボットアームの他にも自動で動くワゴンなどもあり
MUJINのロボットを使った完全自動物流倉庫が既に出来上がっているとのことです。
モーションプランニングは下記リンク参照
なっなんと。知らない内にもうそんなものが・・・
ちなみに、MUJINのブースのプレゼンターがかなり巧い方です。
もしロボット展行けたら、必ず見学してください。
以降のロボットアームの見方が変わります。
アシストスーツ+α
重い荷物を持つ等、力仕事時に役立つアシストスーツを展示している企業が
ちらほらありました。
物流や介護等で腰にかかる負担を軽減する目的です。
正直そーいうのは既存でいろんなところ見かけるのですが、これは初めてです。
これ、手の動きもフレキシブルにアシストします。
守りたいのは腰だけじゃないですもんね。
運送屋さんに是非、早く普及させてあげて欲しい。
ロボライダー
YAMAHAのブースです。ライダーロボです。
このロボがプロライダーの記録に挑戦する映像が流れていました。
最初はラジコンバイクだと思っていたのですが、ロボの物理操作でした。
バイクに専用インタフェースつけて、ソフトウェア制御しろよ!!
でもイイ!!ロマンがある。
みんな大好きハンコロボ
いろんなところで物議を醸しだしたハンコロボです。
残念ながらハンコ現場は押さえられませんでした。
今は、紙の資料を1ページずつめくって電子化している最中です。
いろんな記事で、ハンコを押す点が取り上げられて
「まずハンコ決済文化をなくせよ」と突っ込まれていました。
説明文は「オフィス向け定型書面押印・冊子型書類の書面電子化」
ハンコを押すのが主目的ではなく
自動化したい業務フローのなかで自動化が難しい部分をなんとか
機械でやっちゃうというものみたいですね。
はい、変態技術に決定!!
日本のステキなマゾ達よ!!
ハンコロボを見て
「合理的に考えてハンコ決済なくせば全部おっけーだろ」と言うのも分かります。
しかしこの国民のマゾっぷりをなめてはいけません。
一揆しちゃうより米の増産に励むような連中です(誉め言葉)。
お上の声には「はい承知しました」です。
しかし思うのです。日本の技術の核心はこの変態さにあるのではないでしょうか。
最短ルートでは決してたどり着けない無駄な技術蓄積がある。
そして、その無駄は今は無駄だが未来には黄金に変わる時がある。
ハンコを押すロボットアームの動作の研究だって、多くの知見を生んだ
ことでしょう。
お金に直結しない技術開発に寛容であることはとてもいいことだと思います。
5年後の未来
5年後、世の中はどうなっているだろうか
今自分がやっている仕事はあるだろうか?
今回の展示で自動化が容赦なく進んでいるのが実感できた。
ある日突然無防備で解雇にならないように
最新技術の動向は探っていこう、来年も行くで。
書籍紹介 統計学が最強の学問である[数学編]
どーも
高校の頃、微分あたりで数学から足を洗った者です。
当時は「コレなんの役にたつの?」ってスナック感覚で
ドロップアウトしちゃいました。
それから数十年・・・
数学の本ばかり増えてます。
しかも、ほとんど読んでねーの(笑
電験三種の受験で多少の数学は学び直したのですが
数学はできるようになっておいた方が良いというのは
分かっているんですけどね。
なんかこう、それ学んで実利はあるのかってすぐに思っちゃうんですよね。
そうなんです。数学を勉強する目的がはっきりないんです。
だから三日坊主です。
そんな私ですが、じっくり読んで、手を動かしてみようと
思える数学の本に出会いました。
統計学が最強の学問である[数学編]――データ分析と機械学習のための新しい教科書
https://www.amazon.co.jp/dp/B077SCQGQ3/ref=dp-kindle-redirect?_encoding=UTF8&btkr=1
この本には明確な目的があります。タイトル通り
データ分析と機械学習に使う数学を理解することです。
私は今そーいうのとは全く関係ない仕事してます。
しかし、データ分析と機械学習を知ってる、使えるは
これからある程度の収入を得るためには最低限の教養になるという予感があります。
3分の2ぐらい流し読みしたのですが、確率や微分積分、対数等の性質があれあれに
有用で、それから派生したそれそれに効いてくるというような説明がとてもイイ。
これで、数学の各分野に一本の背骨が通るんですよ。
今まで、数学の学習に挫折した理由は、各分野をまんべんなく均している間に
飽きちゃったことにあります。
データ分析と機械学習に必要な数学だけ
それだけを学ぶ。
わざわざ文章にしちゃったんで、続けるぞー。
そしてゴールはこれに挑戦すること。
https://www.oreilly.co.jp/books/9784873117584/
PCとゲームについて
前回PCを購入したのが2014年初頭。
バトルフィールド4がやりたくて購入。20万ぐらいしたと思う。
それから約5年、PCゲームの要求スペックはどんどんあがり、
最新作のゲームをやるには現行のPCでは厳しくなってきた。
また、モニターがHDから4Kモニターになったため、ゲームをやるとなると
要求されるグラフィック性能もそれなりのものとなる。
さらに、PCがクソうるさい。冷却のためのファンがうるさ過ぎる。
最近引っ越しをして3階に住んでいるうえに、階下は大家一家という状況。
折角手にいれた「カドベヤ、ミナミ、サイジョーカイ」を手放したくない。
ぬうう、PC買い替えよう。
前と同じで、ドスパラでええか。おっ、静音PCはサイコムちゅうとこがええねんか、ほうほう、グラフィックカードは今は結構静かなのがあるのね。ふんふん。サイコムで買うたるわ。ほうほう、ファンにはこだわりがあって、ノクチュアとかいうメーカーがええねんて。そうや、ウチのPCファンがクソうるさくてかなわんのや、どーにーかしてやー。で、お値段15万えーん。
15万円かー。・・・他にも欲しいのあるのよね。pixcel4とかgopro MAXとかね。
んー。現行PCのファンとグラフィックカードだけ交換して、なんとかならんものやろか。
結果、なんとかなりました。
4Kでも非常に快適。
真ん中が最小値、右が最大値。GPU(グラフィックカード)は最大70℃まで上昇しているが、適正値。CPUの温度も問題なし、交換したファンが効いてる。
60℃までは1000rpmで回転するように設定してある(ファンの音を下げるには低回転にするのが良い、1000rpmを超えてくるとうるさくなってくる)。
ふふふ、いけたじゃないですかー。
しかも静か、購入したグラフィックカードはハイエンドの部類。
静音と性能は両立しないのがこれまでの世の掟
いい時代になったものです。
さて、次はグラフィックカードの購入特典であるゲームやりますよ。
「call of duty modern warfare 2019」
容量が150GB、150GBです。
グラフィックはかなり期待できるんじゃないでしょーか。
おらー プレイボタン ポチーーーーーーーーー
・・・このOSはゲームプレイに対応してません・・・
は?
教えてgoogleおじさん
googleおじさん「ほっほっほ、お主のwindowsは8.1じゃろ、このゲームは対応して
おらんのだよ」
まじかー
googleおじさん「ニッチなOS使うとるお前さんはAKBじゃなくて、あえて地下アイドルを応援して、通ぶってるタイプじゃろ」
うっ、うるせー、もう用が済んだんからネット空間に帰れよー。
OSのアップグレードが必要になってしまいました。
またお金がかかる予感です。
おとなしく、PC新規購入したほうが良かったのでは。
CPU周りのパーツもリフレッシュできるし。
まあ、お金かけずになんとかなったんだけどね。
そのへんについては次回へ続く。
はじまりのはじまり
ブログ始めました。
日々の鬱憤がMAXなので、そろそろ
どこかで吐き出さにゃなぁと思っていました。
家族や、職場の立場の弱い人に憤りをぶつけるのではなく
書くことで昇華出来れば幸いかなぁと思います。
それでは、はじまり、はじまり。