t-hom’s diary

主にVBAネタを扱っているブログです。

Excel Tips アンケートや調査フォームでデータの入力規則をもう一工夫する。

Excelでアンケートや調査フォームを作成する際によく見かけるのが、入力規則を用いたドロップダウンリスト。

一般的に多いのが固定の選択肢が用意され、それ以外がエラーになる仕組みである。
f:id:t-hom:20200918211250p:plain


自由入力では設問の趣旨が伝わらず、トンチンカンな回答が返ってくる場合がある。
だからあらかじめ予想される回答を選択肢として用意し、そこから選択してもらおうという発想だ。
選択肢が十分に想定できる場合や、そもそも例外が存在しない場合はこれで良い。

しかしこの方法はドロップダウンリストにない項目は選択できないため、当てはまる選択肢がない場合に情報を取りこぼす恐れもある。

そこで私がたまに使うのは、基本的にはリストで選択肢を用意しつつ、手入力も受け付ける方法である。
f:id:t-hom:20200918212352p:plain

まぁ同じデータ入力規則でちょっと別のタブを触るだけなので、ひょっとして知ってる方も多いかもしれないがその割にこれまでの会社員経験で見かけたことがないので初めて知るという方も案外多いかもしれない。

設定箇所はデータ入力規則のエラーメッセージタブ。
デフォルトではスタイルは停止になっており、タイトルやメッセージは設定されていないが、これを警告にすると先に見せたように継続するかどうかを尋ねるプロンプトになる。タイトルやメッセージも適切なものを設定しておこう。
f:id:t-hom:20200918212910p:plain

あと、同じくデータ入力規則の入力時メッセージタブで設定できるメッセージも便利。
f:id:t-hom:20200918213140p:plain

これはどちらかといえばリストよりは、「すべての値」の時に使うことが多い。

データの入力規則機能は「規則」部分だけ注目されてる気がするが、その他の機能も意外と便利なので紹介してみた。

知らなかった!という方はこれを機に活用してみて欲しい。
そんなの知ってるし!という方は、それにしては活用例を見かけないので布教よろ。

以上

VBA Excelガントチャート作成マクロ

今回はVBAでExcelガントチャートを作成するマクロを紹介する。
作成したガントチャート自体はマクロに依存せずExcelの基本機能で動作する。

完成すると以下のようなイメージになる。
f:id:t-hom:20200712012937p:plain

大元のアイデアはこちらのYouTube動画を参考にしている。

動画だと英語の解説で結構操作スピードも速い。また、手動で作成しているので毎回再現するのも面倒だ。
テンプレートを作って使いまわしても良いが、それよりもいつでも再現できるVBAコードの形で残しておこうと思って今回マクロ化した。

オリジナルを参考にしつつ私が新たに追加した機能は次のとおり。

  • 現在進行中のタスクを赤い三角でマーク
  • "Phase"で始まるタスク名を太字と色で強調
  • 計画(PLANNED)と実績(ACTUAL)が入力でき、ガントチャートの方でもPLANNEDが背景塗りつぶし、ACTUALが「≫」で表示
  • 現在のSTATUSはPLANNEDとPROGRESSから自動入力され、Delayはオレンジ系、Over Dueは赤系の色で警告
  • テーマカラー使用の為、ページレイアウトの配色から簡単に好みの色合いに変更可能

使い方

コードが非常に長いので先に使い方を説明する。
マクロを実行すると新規ブックに次のようなフォームが作成される。
f:id:t-hom:20200712014604p:plain
テーマカラーを多用しているのでオフィスのバージョンによって異なると思われる。

次に以下の薄黄色で示した箇所を手入力する。(説明のために塗っただけで、実際は白背景)
f:id:t-hom:20200712015425p:plain

このときタスク名にPhaseで始まる名称を使用すると自動的に強調される。

タスクは手動でインデントするとより見やすくなる。
f:id:t-hom:20200712015644p:plain

ページレイアウトタブの配色から好きな色を選択する。
f:id:t-hom:20200712015740p:plain

あとはファイル名を付けて保存すれば完成。
作成されたガントチャートはVBAを使用しないのでxlsxで保存すればOK。

7/12 10:30 追記

土日及び祝日を網掛けする機能を追加した。祝日はAT列に手動で入力する想定。コードも修正済。
f:id:t-hom:20200712103101p:plain

7/25 22:00 バグ修正

Over Dueの計算式が間違っていたので修正

Before

    sh.Range("I8").FormulaR1C1 = "=IF(OR(ISBLANK(RC[-5]),ISBLANK(RC[-4])),""""," _
        & vbLf & Space(4) & "IF(RC[-1]=1,""Completed""," _
        & vbLf & Space(4 * 2) & "IF(AND(RC[-1]=0,RC[-5]>=TODAY()),""Not Started""," _
        & vbLf & Space(4 * 3) & "IF(AND(RC[-1]<1,RC[-4]<=TODAY()),""Over Due""," _
        & vbLf & Space(4 * 4) & "IF((TODAY()-RC[-5])/(RC[-4]-RC[-5]+1)>=RC[-1],""Delay""," _
        & vbLf & Space(4 * 5) & """In Progress"")))))"

After

    sh.Range("I8").FormulaR1C1 = "=IF(OR(ISBLANK(RC[-5]),ISBLANK(RC[-4])),""""," _
        & vbLf & Space(4) & "IF(RC[-1]=1,""Completed""," _
        & vbLf & Space(4 * 2) & "IF(AND(RC[-1]=0,RC[-5]>=TODAY()),""Not Started""," _
        & vbLf & Space(4 * 3) & "IF(AND(RC[-1]<1,RC[-4]<TODAY()),""Over Due""," _
        & vbLf & Space(4 * 4) & "IF((TODAY()-RC[-5])/(RC[-4]-RC[-5]+1)>=RC[-1],""Delay""," _
        & vbLf & Space(4 * 5) & """In Progress"")))))"

コード

今回は条件分岐等が生じない単なる再現系マクロなので、マクロ記録に毛が生えた程度のコードである。
ある程度コード整理はしたものの、プロシージャ分割等は一切しなかった。

NUMBER_OF_TASKSの値がタスクの行数を表すので、ここを変えると任意のタスク数でガントチャートを作成できる。
他に変更を想定したパラメーターは特にない。
※ちなみにWEEKの値は1週間が7日であることを示す定数なので変更してはならない。

Sub CreateGantt()
    Const WEEK As Integer = 7
    Const NUMBER_OF_TASKS As Integer = 100
    
    '#General Setting
    Dim sh As Worksheet
    Set sh = Workbooks.Add.Sheets(1)
    ActiveWindow.DisplayGridlines = False
    With sh.Cells.Font
        .Name = "Meiryo UI"
        .Size = 9
    End With
    
    '#Header Setting
    sh.Range("A1").Value = "Input Project Name Here"
    With sh.Range("A1").Font
        .Size = 22
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.25
    End With
    
    sh.Names.Add "R_ProjectStart", sh.Range("C3")
    sh.Names.Add "R_DisplayWeek", sh.Range("C4")
    
    With sh.Range("R_ProjectStart")
        .Value = Date
        .Offset(0, -1).Value = "Project Start:"
        .Offset(0, -1).HorizontalAlignment = xlRight
    End With
    
    With sh.Range("R_DisplayWeek")
        .Value = 1
        .Offset(0, -1).Value = "Display Week:"
        .Offset(0, -1).HorizontalAlignment = xlRight
    End With
    
    Dim headerCursor As Range: Set headerCursor = sh.Range("A7")
    Dim h
    For Each h In Split(",TASK,ASSIGNED TO,START,END,START,END,PROGRESS,STATUS", ",")
        headerCursor.Value = h
        Set headerCursor = headerCursor.Offset(0, 1)
    Next

    Dim dateCursor As Range: Set dateCursor = headerCursor.Offset(-1, 0)
    dateCursor.Formula = "=R_ProjectStart-WEEKDAY(R_ProjectStart)+1+((R_DisplayWeek-1)*7)"
    dateCursor.NumberFormatLocal = "d"
    With dateCursor.Offset(0, 1)
        .FormulaR1C1 = "=RC[-1]+1"
        .AutoFill Destination:=.Resize(1, WEEK * 5 - 1), Type:=xlFillDefault
    End With
    dateCursor.Resize(1, WEEK * 5).EntireColumn.ColumnWidth = 3
    dateCursor.Resize(2, 1).EntireRow.HorizontalAlignment = xlCenter
    
    Dim weekdayCursor As Range
    Set weekdayCursor = dateCursor.Offset(1, 0)
    With weekdayCursor
        .FormulaR1C1 = "=LEFT(TEXT(R[-1]C,""ddd""),1)"
        .AutoFill Destination:=.Resize(1, 7 * 5), Type:=xlFillDefault
    End With

    Dim weekCursor As Range: Set weekCursor = dateCursor.Offset(-1, 0)
    With weekCursor
        .FormulaR1C1 = "=R[1]C"
        .NumberFormatLocal = "yyyy/m/d;@"
        .Font.Size = 12
        With .Resize(1, WEEK)
            .Merge
            .HorizontalAlignment = xlLeft
            .AutoFill .Resize(1, WEEK * 5)
        End With
    End With
    
    'Paint
    Dim headerRange As Range
    Set headerRange = sh.Range(Cells(headerCursor.Row, 1), headerCursor.Offset(0, WEEK * 5 - 1))
    With headerRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.5
        .PatternTintAndShade = 0
    End With
    headerRange.Font.Color = rgbWhite

    With weekCursor.Resize(1, WEEK * 5).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.5
        .PatternTintAndShade = 0
    End With
    
    With dateCursor.Resize(1, WEEK * 5).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.8
        .PatternTintAndShade = 0
    End With

    Dim r As Range
    Set r = weekCursor
    For i = 1 To 5
        With r.Resize(2, WEEK)
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 2
                .TintAndShade = 0.5
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 2
                .TintAndShade = 0.5
                .Weight = xlThin
            End With
            .Borders(xlEdgeBottom).LineStyle = xlNone
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 2
                .TintAndShade = 0.5
                .Weight = xlThin
            End With
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        Set r = r.Offset(0, 1)
    Next
    
    Dim bodyRange As Range
    Set bodyRange = headerRange.Offset(1, 0).Resize(NUMBER_OF_TASKS)
    bodyRange.RowHeight = 16.5
    With bodyRange
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 2
            .TintAndShade = 0.5
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 2
            .TintAndShade = 0.5
            .Weight = xlThin
        End With
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ThemeColor = 2
            .TintAndShade = 0.5
            .Weight = xlThin
        End With
    End With
    
    'Gantt Bar
    Dim ganttRange As Range
    Set ganttRange = weekdayCursor.Offset(1, 0).Resize(NUMBER_OF_TASKS, WEEK * 5)
    ganttRange.FormulaR1C1 = "=IF(AND(RC6<=R6C,R6C<=RC7),""≫"","""")"
    With ganttRange
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With ganttRange.Font
        .Size = 16
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = -0.5
    End With
    
    With ganttRange
        .FormatConditions.AddColorScale ColorScaleType:=2
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
        With .FormatConditions(1).ColorScaleCriteria(1).FormatColor
            .Color = 2650623
            .TintAndShade = 0
        End With
        .FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValueHighestValue
        With .FormatConditions(1).ColorScaleCriteria(2).FormatColor
            .Color = 10285055
            .TintAndShade = 0
        End With
        .FormatConditions.Add Type:=xlExpression, Formula1:="=AND($D8<=J$6,J$6<=$E8)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.25
        End With
        .FormatConditions(1).StopIfTrue = False
    End With

    'Progress Data Bar
    With sh.Range("H8").Resize(NUMBER_OF_TASKS)
        .HorizontalAlignment = xlCenter
        .NumberFormatLocal = "0%"
        .FormatConditions.AddDatabar
        .FormatConditions(.FormatConditions.Count).ShowValue = True
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            .MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0
            .MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1
        End With
        With .FormatConditions(1).BarColor
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.6
        End With
        .FormatConditions(1).BarFillType = xlDataBarFillSolid
        .FormatConditions(1).Direction = xlContext
        .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
        .FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
        .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
        With .FormatConditions(1).AxisColor
            .Color = 0
            .TintAndShade = 0
        End With
        With .FormatConditions(1).NegativeBarFormat.Color
            .Color = 255
            .TintAndShade = 0
        End With
    End With
    
    'Highlight Today
    With ganttRange.Offset(-2, 0).Resize(ganttRange.Rows.Count + 2)
        .FormatConditions.Add Type:=xlExpression, Formula1:="=J$6=TODAY()"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Borders(xlLeft)
            .LineStyle = xlContinuous
            .Color = -16776961
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .FormatConditions(1).Borders(xlRight)
            .LineStyle = xlContinuous
            .Color = -16776961
            .TintAndShade = 0
            .Weight = xlThin
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    
    'Scroll Bars
    sh.ScrollBars.Add(weekCursor.Left, weekCursor.Top - 16.5, weekCursor.Resize(1, WEEK * 5).Width, 14).Select
    With Selection
        .Value = 1
        .Min = 1
        .Max = 52
        .SmallChange = 1
        .LargeChange = 10
        .LinkedCell = "R_DisplayWeek"
        .Display3DShading = False
    End With

    sh.Range("I8").FormulaR1C1 = "=IF(OR(ISBLANK(RC[-5]),ISBLANK(RC[-4])),""""," _
        & vbLf & Space(4) & "IF(RC[-1]=1,""Completed""," _
        & vbLf & Space(4 * 2) & "IF(AND(RC[-1]=0,RC[-5]>=TODAY()),""Not Started""," _
        & vbLf & Space(4 * 3) & "IF(AND(RC[-1]<1,RC[-4]<TODAY()),""Over Due""," _
        & vbLf & Space(4 * 4) & "IF((TODAY()-RC[-5])/(RC[-4]-RC[-5]+1)>=RC[-1],""Delay""," _
        & vbLf & Space(4 * 5) & """In Progress"")))))"
    
    sh.Range("I8").AutoFill sh.Range("I8").Resize(NUMBER_OF_TASKS)
    
    'Status Format
    With sh.Range("I8").Resize(NUMBER_OF_TASKS)
        .HorizontalAlignment = xlCenter
        .FormatConditions.Add Type:=xlTextString, String:="Completed", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = rgbGray
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .Color = rgbGainsboro
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        
        .FormatConditions.Add Type:=xlTextString, String:="In Progress", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = rgbDarkGreen
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .Color = rgbHoneydew
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        
        .FormatConditions.Add Type:=xlTextString, String:="Delay", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = rgbSienna
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .Color = rgbBisque
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        
        .FormatConditions.Add Type:=xlTextString, String:="Over Due", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = rgbFireBrick
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .Color = rgbPink
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    
        .FormatConditions.Add Type:=xlTextString, String:="Not Started", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Color = rgbDarkGray
            .TintAndShade = 0
        End With
        With .FormatConditions(1).Interior
            .Color = rgbWhite
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    
    'Format Start End Dates
    With sh.Range("D7:E7").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = -0.25
        .PatternTintAndShade = 0
    End With
    
    With sh.Range("F7:G7").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = -0.25
        .PatternTintAndShade = 0
    End With

    sh.Range("D6").Value = "PLANNED"
    sh.Range("D6:E6").Merge
    With sh.Range("D6:E6").Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = -0.25
    End With
    
    sh.Range("F6").Value = "ACTUAL"
    sh.Range("F6:G6").Merge
    With sh.Range("F6:G6").Font
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = -0.25
    End With
    
    With sh.Range("D7:E7,F7:G7").Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With sh.Range("D7:E7,F7:G7").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With

    'Current Task Picker
    With sh.Range("A8").Resize(NUMBER_OF_TASKS)
        .Interior.Color = rgbWhiteSmoke
        .FormulaR1C1 = "=IF(AND(NOT(ISBLANK(RC[3])),RC[7]<1,RC[3]<=TODAY()),""▲"","""")"
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .Orientation = -90
        With .Font
            .Size = 11
            .Color = 192
        End With
    End With

    'Phase Format
    With sh.Range("B8").Resize(NUMBER_OF_TASKS)
        .FormatConditions.Add Type:=xlTextString, String:="Phase", TextOperator:=xlBeginsWith
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
            .Bold = True
            .Italic = False
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    
    sh.Range("D8:G8").Resize(NUMBER_OF_TASKS).NumberFormatLocal = "yyyy/m/d;@"
    
    sh.Columns("A:A").ColumnWidth = 3
    sh.Columns("B:B").ColumnWidth = 35
    sh.Columns("C:C").ColumnWidth = 13
    sh.Columns("H:H").ColumnWidth = 10
    sh.Columns("I:I").ColumnWidth = 10
    
    'Holiday Format
    With sh.Range("J8").Resize(NUMBER_OF_TASKS, WEEK * 5)
        .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(J$7=""S"",NOT(ISNA(VLOOKUP(J$6,$AT:$AT,1,FALSE))))"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .Pattern = xlLightDown
            .PatternColor = 11711154
            .PatternTintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    
    With sh.Range("AT7")
        .Value = "Holidays"
        With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.5
        .PatternTintAndShade = 0
        End With
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    End With

    With sh.Range("AT8").Resize(NUMBER_OF_TASKS)
        .NumberFormatLocal = "yyyy/m/d;@"
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 13434879
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
End Sub

在宅勤務用にミュートスイッチを作成

在宅勤務で受電時に瞬時にミュートできるスイッチを作ったので紹介しようと思う。

実際のモノはこんな感じで、だいたいマウスくらいのサイズ。ミュート中はLEDが赤く点滅する。
f:id:t-hom:20200606041804g:plain

なんでこんなものを作ったのか

私の自宅では定刻になったらラズパイが可愛らしい音声で食事や家事や運動や勉強を促してくれるガイダンスシステムを導入している。

それによってあらかじめ設計した生活リズムをキープしているのだが、在宅勤務だと残業で電話会議している最中に音声ガイダンスが発動するのでそれを黙らせるためだ。
黙らせるだけならラズパイ側でミュートしておけば良いんだけど、問題はミュートしたことを忘れて音声ガイダンスがずっと無効化されてしまうので、ミュート中はミュートであることをアピールするようなスイッチが欲しかった。

以上が作成の経緯。
まぁ他にも資料作成中なんかは音楽をかけたほうが仕事がはかどったりするので、その時に受電したら瞬時にミュートするという用途でも使っている。

構造

日本開閉器という会社の4極単投スイッチ(型番 S-41-J)を使用している。
これはON時に4回路が同時につながり、OFF時に4回路が切れるタイプ。

以下がデータシート
f:id:t-hom:20200606043445p:plain

1-3, 7-9, 4-6, 10-12という表記はどの接点が繋がるかを表し、これを図示するとこうなる。
f:id:t-hom:20200606050108p:plain

ちなみに2, 8, 5, 11の接点はこのスイッチにはなく、同シリーズのS-42-Jという型番用である。実はそっちを買えばもっとシンプルにできたことを知って結局買いなおしたのだが、まだ届いてないのでとりあえずS-41-Jで作った。

接続図

f:id:t-hom:20200606045346p:plain

3.5ミリ ステレオ3極ジャックのケーブルの中身はL線とR線とグランド線になってるので、ミュートの仕組み自体は単純に音声ケーブルの各端子をスイッチにつないでるだけのシンプルなもの。

以下のサイトを参考にしたんだけど、接続をよく見てなくて、単純にON・OFFだと思いこんでた。
実際にはL線とR線をグランド接続することでミュートしてるようだけど、どうするのが正解かよく分からないのでまぁ単純OFFで良いかなと。。
craftsman.gtfm.org


NOT回路の方は電気知識のない私にはややこしかったけど、B-1 論理回路の基本というサイトで予習しつつ、回路シミュレータ―でLEDに流れる電流が適切になるように抵抗値を調整して作成した。

makezine.jp

f:id:t-hom:20200606052327g:plain

中身

実は閲覧禁止レベルのひどい中身。試作機ということでご容赦を。。
f:id:t-hom:20200606053518p:plain

音声ケーブルはスイッチの端子穴に通してねじってるだけ、NOT回路とスイッチの接続はワニ口クリップからブレッドボードへ、USB給電からNOT回路へもワニ口クリップからブレッドボードへ、LEDはジャンプワイヤーのメスに挿してるだけで蓋を開けるたびに抜ける始末。

S-42-Jを利用した改善案

S-42-Jは、日本開閉器の4極双投スイッチである。最初データシートだけ見て意味が分かってなかったので変な風に接続されるのを嫌ってON-OFFスイッチのS-41-Jを買ったんだけど、S-42-Jを使えばNOT回路がそもそも要らないことに気づいた。
f:id:t-hom:20200606055133p:plain

図にするとこんな感じ。
f:id:t-hom:20200606055039p:plain

箱の中身はブレッドボードが丸ごと消えて、抵抗1個に置き換わるイメージ。

あとは現状の回路だとLEDがOFF時も電力を食うけど、NOT回路をなくして単純スイッチにすればLEDがOFFの間は電力が消費されないのでUSBから給電しなくても乾電池で1か月くらい実用的に動作するかもしれない。ミュートにするのは週に4時間の定例ミーティングと不定期の会議が毎日1~2時間くらい。このあたりもちゃんと計算して改善したい。

古いお風呂の入浴環境をUpgradeするアイテム

最近湯舟につかろうと思い立った。
これまで10年ほどほとんどシャワーのみで過ごしてきたのに、なんでまたこれから暑くなる今から入浴なのかというと、とある動画の影響である。
このところ疲れを感じていた私に、しっかり疲れを取るには入浴が効果的という文句が刺さった。

うちの風呂は設備が古く、湯舟もかなり小さい。なんというか、正方形で深いやつ。
肩まで浸かろうと思うとターミネーターの登場シーンばりに体を折り曲げなければならない。

それでもなんとか、疲労回復とリラックスタイムを手に入れたく、入浴環境をUpgradeした。

まず風呂蓋。そもそも風呂蓋がない。賃貸契約したときから付いてなかったから通うなら自分で買えということだろう。
それでこれを発注した。

70×79。うーん狭い。
これは届いているものの、まだ使っていない。
月曜にダスキンさんを呼んでるので、本格的に風呂掃除してもらってから、使おうと思う。

次にお湯張り用のタイマー

オリエント 湯温計付 バスアラーム 1003

オリエント 湯温計付 バスアラーム 1003

  • メディア: ホーム&キッチン

水位センサーと温度センサーがついていて、アラームで知らせてくれる。Amazonレビューでアラームが小さくて気付かないという書き込みがあったけど、私の場合はそんなこともなかった。多分部屋と風呂の距離と構造によるんだろうな。
最近のお風呂ならこんなもの無くてもお湯張り・温度調節もフルオートなんだろうけど、うちの風呂はアナログなので水の溜まり具合を逐一確認しなければあふれてしまうし、湯加減を時折チェックしなければ煮えたぎってしまう。

次に湯かき棒

風呂を混ぜるのに専用の道具があるというのは初めて知った。
うちは2穴の追い焚きタイプの風呂釜。いわゆる昔のやつ。水面を触ると火傷しそうなほど熱いのに水中は冷たいままで、手でかき混ぜるのも一苦労だったけどこれ超便利。ヒノキの良い香りがする。

最後に完全防水のBluetoothスピーカー

最新版があるらしいけど、私は気づかずに上記の商品を買った。

音質はやっぱ普段使いのBOSEが良すぎていまいちかなと思ったんだけど、風呂で聴くと反響のせいか結構良い感じに聞こえる。

個人的にはスピーカーが一番買って正解だったと思う。
私の場合、湯舟に使ってるとなんか手持無沙汰ですぐ上がってしまうので音楽があったほうがゆったりとリラックスできる。

ハウスダストの移動モデルと対策アイテム

掃除してもしても無限に湧き出てくる埃。1日床掃除しなかっただけで掃除機をかけるとびっくりするくらいの量がとれる。

一体どこから湧いて出るのか。
気になって海外の動画等で調べてみると、まずハウスダストの60%は家の外から持ち込まれ、残り40%は服の繊維や布団など、つまり人間生活から発生しているらしい。

今回はハウスダストアレルギー持ちの私がハウスダストの移動モデルと今やってる対策を紹介する。
実は単に暇だったので以前から考えていた持論を図式化したくなっただけなんだが。

私の家のハウスダスト対策をモデル化したのがこちら。
f:id:t-hom:20200517155646p:plain

持ち込まれたあるいは発生した埃は空気中を舞い、最終的に床や物に降り積もる。
そして床を歩いたり物を触ったり風が吹いたりするとまた空気中に舞い戻る。

某研究によると空気中の埃は最大で9時間ほど舞い続けるらしい。
そして空気中の埃を人が吸い込むことでハウスダストアレルギーを発症する。

どの程度吸い込むかによって症状の程度も変わるのでアレルギー対策としては空気中の埃の全体量を減らすことが重要である。
よって直接的に空気中の埃を取り除く空気清浄機は必需品。

私が使っているものを紹介できれば良いのだけど、さすがに10年以上前のモデルなのでやめておく。ちなみにDAIKIN製。

次に重要なのは最も埃の積もる面積が多い床の対策。床を頻繁に掃除すれば部屋の埃の総量はかなり減るので、つまり結果的に空気中の埃の量も減る。

頻繁に掃除するのが面倒であればロボット掃除機がおススメ。ルンバじゃなくて良い。2万以下の製品で十分綺麗になる。
私が使ってるのはこちら。

壁掛け充電式の掃除機もあると便利。これもダイソンじゃなくて良い。1万以下の製品で十分。
私が使っているのはこちら。

吸引力が弱いというレビューもあってどうなんだと思ってたんだけど、ダイソンのあのごつごつ感がどうも好きになれず、白くてシンプルな家電が好きなので買ってみた。
確かにダイソンほどの吸引力は無いかもしれないが、これまで何かが吸えなくて困るということは無かったし、そもそも普通の掃除機で吸えないようなものは空気中に舞い上がってくることもないので埃掃除には十分なのだ。

ただひとつクセがあって、出力はレベルは弱と強の2種類なんだけど、電源ON直後にすぐ強に切り替えると電源が落ちる。
電源ONすると弱でスタートするのでモーターの回転数が弱の最大まで上がりきってから強に切り替える必要がある。
だいたい電源ONから3秒待てば強に切り替えても大丈夫。値段が安いのでそこは我慢だ。


あとは物に溜まる埃。特に机。これはハンディ―ワイパーで絡めとる。

ウェーブ ハンディワイパー 掃除用 本体 1本+取替えシート 1枚

ウェーブ ハンディワイパー 掃除用 本体 1本+取替えシート 1枚

  • 発売日: 2008/09/16
  • メディア: ヘルスケア&ケア用品

入り組んだ場所やパソコンの中身なんかはエアダスターを使えばよいけど、あれば溜まった埃を空気中に戻しているだけなので時間がたつとまた部屋にまんべんなく降り注ぐということを意識しておきたい。それに長時間舞い続けるのでアレルギー対策としては非常によろしくない。
できることなら外で吹き付けるか、空気清浄機を最大運転するか、掃除機と併用して吹いた傍から吸い込むのが良い。

最後に、部屋掃除を省力化するためには、平面を多く出すと良い。物を飾れば飾るほど平面が減って掃除がしにくくなるし、スッキリ見えなくなる。ただそこは趣味嗜好もあると思うので別に物が多い状態が悪いとは思わない。掃除が大変というだけで。

以上

ど素人がオーディオインターフェースを買ってみた話

はじめに断っておくと、私にはオーディオの深い世界が分からない。

聴覚に医学的な異常はないので、悪い音とそこそこ良い音の区別はつく。
しかし、そこそこ良い音と最高に良い音の区別はつかないと思う。

単に聞いたことがないからという理由でそう思い込んでいるだけかもしれないし、クラッシックのような繊細な音楽を聴くわけではないので違いに気付かないだけかもしれない。そもそもクラッシックが繊細だなんてのも私の勝手なイメージで、どこかで聞きかじった程度の知識にすぎないのだが。

これまではPCのマザーボードに標準でついているLINE-OUTからBOSEの1万円ちょっとのPCスピーカーにつないでいた。これだけで特に音質に関して何の不満もなかった。聴覚には個人差があるだろうけど、オーディオマニアではない一般人の感覚からすればこれで十分だと思う。

BOSEのスピーカーは原音に忠実ではなく、いい音に聞こえるようにチューニングされているらしい。これも聞きかじった話なので真偽は不明だが、確かに他の4~5千円のPCスピーカーとは別格だと思った。ここまでは私の耳でもわかる。


さて、そんな私が最近USBオーディオインターフェースを購入した。YouTuber御用達のこれ。

オーディオインターフェースを使用すると、本格的なオーディオ機器をPCで使用することができる。

購入のきっかけはコロナ禍による在宅勤務の本格化。

私はマイクで話すときに自分の声がどう聞こえるのかフィードバックが欲しいので、Windowsの機能でマイク音声を聴いていた。ただWindowsの機能では自分の発話と聞こえてくる自分の声に0コンマ何秒かの遅延があり、聴いていてすごくイライラする。

遅延の原因は、アナログ信号とデジタル信号の変換に時間がかかるためだ。
マイクが拾った生音声はデジタル信号に変換されてPCに取り込まれる。それからまたアナログ信号に変換されてスピーカーやヘッドフォンから出力される。

f:id:t-hom:20200509172516p:plain

この変換は高速に行われる為、誰かとボイスチャットするだけなら大した問題にはならない。
ただ自分の声をヘッドフォン越しに聴くとなると話は別で、しゃべってるのに発話が微妙に追い付いていないかのような感覚が神経をいらだたせる。

そこで調べて出てきた解決策がオーディオインターフェースである。
オーディオインターフェースを使用するとアナログ信号とデジタル信号の変換はオーディオインターフェース内で完結し、PCはデジタルデータしか扱わなくてよくなるので負荷が下がる。

自分の声に遅延が発生しない理由はアナログ信号をデジタル変換する前にそのままヘッドフォンにも流すような回路になっているんだと思う。
全く想像で書いてるので本当のところは知らないけど遅延がない以上そう考えるのが合理的だ。
f:id:t-hom:20200509172557p:plain

他のオーディオインターフェースを知らないのでそもそも自分の声を遅延なく聞けるのがこのAG03の特徴なのか、オーディオインターフェース全般がそうなのかは不明。

なおPC上のデバイスを聴くという設定は外しておかないと遅延音声も一緒に聞こえてくると思われるので注意。
また、YAMAHAのAG03にはモニターミュートという機能も付いており、自分の声を聴かない設定もボタン一つでできる。


私はこの時点でオーディオインターフェース導入の目的を果たしたのだが、せっかくなのでAG03の他のメリットも併せて紹介しよう。

  1. 自分のマイク音声を遅延なく聞ける。
  2. PC用のちゃちいマイクではなく本格的なマイクが接続できる。
  3. 従来のPC用機材も接続できる。
  4. デジタルとアナログの変換をオーディオインターフェースに丸投げできるのでPCに負荷がかからない。
  5. 音質が良くなる。
  6. 複数機器から出力される音を混ぜ合わせて1つのスピーカー・ヘッドフォンから鳴らすことができる
  7. 各接続機器(マイク・PC・スピーカー・ヘッドフォン・その他ギター等)のボリュームを個別に調整できる。

本格的なマイクについては例えば私が買った製品がこちら。

SHURE シュアー / SM58S

SHURE シュアー / SM58S

  • メディア: エレクトロニクス

音楽ライブでボーカルが使うようなものらしいので普通のトーク用にはオーバースペックかもしれないけどそこは下手の横好きでばっちり散財した。確かに音は良いので満足している。

これはダイナミックマイクというタイプで、カラオケで見慣れている形状の為かちょっとダサい感じはする。
ダイナミックマイクは環境音を拾いにくいとのことでこれにした。

コンデンサーマイクの方が見た目は格好いいし、繊細な音までとれるらしいので静かな環境であればそちらのほうが良いかもしれない。

さらにマイクアームと金属製のポップガードも買った。ポップガードというのはマイクに直接息がかかったときのボフっという風音をかなり低減してくれるアイテム。ミュージシャンがスタジオで録音するときにマイクの前にある円盤型の黒いフィルターがそれ。


さて、オーディオインターフェースによってPC負荷が下がるという話は正直最近のPCであれば関係ない気がしている。

ただ、音質が良くなるという話は理屈上は本当のことである。
PC内はノイズが多いのでそんなところにアナログ信号を入れたら波形が乱れる。これはPC内部でデジタル・アナログ変換を行っているかぎり避けられない問題だ。
一方でデジタル信号は劣化しないのでPCとUSBオーディオインターフェースはデジタル信号で通信し、デジタル・アナログ変換をオーディオインターフェース上で行えばノイズの影響はかなり低減される。

オーディオインターフェースはPCと違って専用の機材なのでそもそも内部に余分なノイズは少なく、対策もされているためだ。

まぁこれはあくまで理屈上の話である。
実際に波形を比較している方もいて、確かにその理屈は正しいというところまでは理解した。

で、実際聴き比べてみてどうだったか。

…わからん。

PCにヘッドフォンを直挿ししたときと、AG03に挿したときと聞き比べてみてもよくわからないのだ。
正確にいえば、音質の変化が分かりやすい特定の音楽を聴いたときに、ほんの僅かに音の質感が変わった感じもする。
ただ良くなったのか悪くなったのかは判別できない。

使用しているヘッドフォンはSONYのWH-1000XM3。


オーディオインターフェースで明らかに音が良くなったという人も居る一方で、なぜ私の場合はその良し悪しが判別できないのだろう。
下記3つの原因が考えられる。

  • もともと使ってるPCのオンボードサウンドが優秀
  • 単に私の耳が肥えていないだけ。
  • もっと高価なインターフェースやヘッドフォンを使わないと違いが判らない。

PCは自作機で、メインボードはこれ。

金属性のカバーで色々覆われててもしかしてノイズ対策になってる?
オーディオ機能を調べると、8チャンネルHigh Definition Audio(Realtek ALC1220)192kHz/32bitとある。
Realtek ALC1220を調べてみるとオンボードサウンドとしてはかなり良い部類らしいので、これのせいで低価格帯のオーディオインターフェースと比べても遜色ない音が出るのかもしれない。
もしかすると安いマザーボードでオンボードサウンドが貧弱なケースでは顕著に音質の向上が感じられるのかもしれない。

あとそもそも私の耳が肥えてないだけで、聴く人が聴けば違いが判るのかもしれない。
そうなると私には関係ない話になるので諦めるしかないが。

あるいはもっと高価な機材を使えば違いが判るのかもしれない。
確かに興味はあるものの現時点では今出ている音で100%満足しており、音質の悪さなど微塵も感じないので正直これ以上良い音というのは想像もつかない世界である。

以上がオーディオインターフェースを買って使ってみた結果である。

さて、せっかく色々と揃えたのだが在宅勤務で活用できているかというとその効果は今のところ限定的だ。
あるツールで1対1で通話するときには比較的高音質で会話できているが、複数名の会議で使われる別のツールではなぜか途中で音声がまったく聞こえなくなってしまう。

おそらく社内の帯域の問題と思われ解決に至らないので、複数名の会議ではスマホから接続することにした。

ではこの投資は無駄だったのか?

私はそうは思わない。
色々調べて機材を買うのはワクワクするしとても楽しい。確かに玄人からみれば素人がプロにあこがれて機材にこだわる姿は滑稽かもしれないが、誰に何と言われようと道具にこだわるというのは楽しいものだ。

そうやってのめりこんで本物の知識を身に着ける人もいるだろう。
私はおそらくそうではない。どこかで満足してそれでおしまい。

でもそれで良いんだと思う。所詮は道楽。楽しむことこそ一番の目的だ。

プログラミングで過去に行き詰った問題に再トライすることの勧め

昨年10月頃に、とあるPythonプログラムで2つの問題に行き詰っていた。
折角の連休なので再トライしてみたところ2つともあっさり解決してしまった。

プログラミングに限らずこういうことはよくある。

一度行き詰ってしまった問題でも、ある程度の期間を置くことで以下のような変化が起きる。

  • その間の学習で自分自身の実力が向上する。
  • 一旦忘れることで新しい視点から問題を見つめなおせる。
  • インターネットや書籍などで情報が充実してくる。
  • 新しい解決策が生まれてくる。

プログラミングでは特にインターネット上で得られる情報が多く、更新スピードも速い。
一人が問題を解決すると、同じ問題に困っていた人がそれを見つけて更にわかりやすく解説記事を出すといったこともよくある。

また検索エンジンの進化や検索されるサイトの変化も早いので、半年前は見つけられなかった解決策が今検索したら一発でヒットするということも珍しくない。

ということで皆さんも過去に行き詰って諦めている問題があれば、期間を置いて再トライをお勧めする。
また、ブログやQiitaで技術記事を書く人は他人とのネタ被りなんて気にせずに自分の切り口で堂々と解説記事を公開してほしいと思う。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。