「Excel」の記事 - Crieit

【実況ブログ】 Excel VBAで初めてのプログラミングを覚えようぜ（＾～＾）？

2023-01-25T20:40:52+09:00

📅2023-01-25 mon 19:15 start

「　Excel を購入しろだぜ」

「　してるぜ」

「　👆　これを使って、プログラミングを覚えてもらう」

「　現代の Excel は　チューリング完全らしいですしね」

「　じゃあ Excel で　チューリング・マシンを作るのか？
無限のテープをどう表現する？」

「　テープが足りなくなったら　強制終了すればいいだろ」

📖 Turing machine

「　👆　例題は Wikipedia を参考にしようぜ？」

[TuringMachineByExcelVBA.xlsm] file - [StateTable] sheet:

State,Read,Write,Move,Transition
A,White,Orange,>,B
A,Orange,Orange,<,C
B,White,Orange,<,A
B,Orange,Orange,>,B
C,White,Orange,<,B
C,Orange,Orange,>,HALT

「　👆　とりあえず StateMachine シートを作れだぜ。
セルに色も塗れだぜ」

「　このシートが何かの説明はしないの？」

「　手を動かせば　あとで分かる」

[TuringMachineByExcelVBA.xlsm] file - [Tape] sheet:

「　👆　もう１つ、 Tape シートを作れだぜ。
A の１文字だけ入っている」

「　これは何なんだぜ？」

「　あとで分かる」

「　空っぽの GUI というシートを作って、
メインメニューから [開発] - [コードの表示] を選べだぜ」

「　👆　VBA のエディターが出てくるな」

「　あの　不便なやつね」

「　ほんと　不便だな。　シートに戻るぜ」

「　👆　先に　ボタンを置こうぜ？」

「　👆　何だか　よくわからないが　ボタン1_Click という名前はそのまんまで
マクロの保存先を　今作業中のファイルに変えて、 [新規作成(N)] ボタンを押そうぜ？」

「　Excel の使い方を記憶してないの　わらう」

「　プログラマーは　記憶　ではなく、　読み　で進むのよ。
その方が　応用が利くから」

「　👆　ボタンがでけてる。
当たった」

「　当たった　とか　講師から出てきたらおかしい言葉　わらう」

「　👆　ボタンを右クリックして　コンテキスト・メニューの [マクロの登録(N)] を
クリックしてみようぜ？」

「　👆　何をすればいいのか分からん。 [OK] ボタンを押してみようぜ？」

「　👆　？
何が起こった？」

「　👆　なんか　コードが増えてるのでは？」

「　よっしゃ！
じゃあ　そこに VBA Script （ぶい・びー・えー・すくりぷと）を書けばいいんだぜ」

📅 2023-01-25 wed 20:41

「　🔍 VBA セルに値を入れる　で検索」

📖 セルに値を入れる：Excel VBA プログラミング入門

「　👆　よし　分かったぜ」

Worksheets("GUI").Range("A1").Value = "Hello, world!!"

「　👆　こんな感じに書けば　GUI シートの A1 セルに　Hello, world!! という文字を
入れてくれそうだな」

「　ボタンを押そうぜ？」

「　👆　ほら　出た」

「　Excelでハローワールドを出力する の実績を解除したな」

「　じゃあ次。
🔍 VBA セルに色を付ける で検索」

📖 セルに色を設定する

「　👆　よし　分かったぜ」

Worksheets("GUI").Range("A1").Interior.ColorIndex = 45 ' オレンジ

「　👆　こんな感じに書けば　GUI シートの A1 セルの背景色をオレンジ色に
してくれそうだな」

「　ボタンを押そうぜ？」

「　👆　A1 セルに色が付いたな」

「　着色の自動化に使えそうねえ」

「　👆　じゃあ、 StateTable シートの C2 セルの背景色が何色かとか、取得することはできるのかだぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA セルの色を取得 で検索」

📖 VBA セルの色を取得する (Interior.Color, ColorIndex)

「　👆　よし　分かったぜ」

    Dim backgroundColor As Long
    backgroundColor = Worksheets("StateTable").Range("C2").Interior.color ' 背景色
    Debug.Print (backgroundColor)

    Worksheets("GUI").Range("A1").Interior.color = backgroundColor

「　👆　こう書けば　StateTable シートの C2 セルの背景色を、 GUI シートの A1 セルへ　コピーできるはずだぜ！」

「　ボタンを押そうぜ？」

「　👆　背景色は　コピーでけたが……。
Debug.Print( ... ) って何だぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA デバッグプリント で検索」

📖 【エクセルVBA】初心者のうちから知っておくべきDebug.Printの使い方

「　👆　イミディエイト・ウィンドウ に値を表示するらしいぜ」

「　イミディエイト・ウィンドウ　って何だぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA イミディエイトウィンドウ で検索」

📖 イミディエイトウィンドウの使い方

「　👆　よし　分かったぜ」

「　[Ctrl] + [G] キーを打鍵すると　出てくるウィンドウだぜ」

「　そんなウィンドウの出し方、　画面のどこを探しても　無くね？」

「　コンピューター開発者は　私には分かる。だからお前も分かるだろ という脳をしてる人　多いのよ。
伝え、継承する精神を持っている人は　リタイア組ぐらいよ」

「　天才が　技術を継承するの　損だしな。
ネット上で　記事書いてるの　リタイア組か、　業界が滅ぶ一歩手前で　しかたなく　天才のケツ掃除してる人たちの　どっちかだよな」

「　しかし 49407 なんて数字出てきても　嬉しくないな」

📅 2023-01-25 wed 21:36

「　じゃあ　次は長めの　コンボ（Combo；連続技）　やるから　よく聴けだぜ」

「　👆　Tape シートの A1 セルに入っている値 A と、その背景色　白色　を取得して……」

「　👆　StateTable シートの State 列に A が、
Read 列に　背景色が白色のセルが
無いかなと探し……」

「　👆　見つけたら……」

「　👆　そのまま　横へスライドし、
Write列の背景色は　オレンジ色、
Move列は > 、
Transition列は B
と　いったん覚え……」

「　👆　Tape シートを開き、
A1 セルから１行下にいったところを、　Write 列にあるように　オレンジ色　に塗り、
Move列が > とあるように　その右側に対して、
Transition列があるように　B　を書き込もうぜ？」

「　長い」

「　いったん TuringMachineByExcelVBA.xlsm ファイルを保存して閉じるぜ。
休憩だぜ」

📅 2023-01-25 wed 22:10 stop

📅 2023-01-25 wed 22:21 restart

「　よっしゃ　再開だぜ！
TuringMachineByExcelVBA.xlsm ファイルを開けて、っと」

「　👆　消えてる！」

「　よく探せだぜ！」

「　👆　無い、無い、無い、
どこにも　無～い！」

「　ファイルを開けるには、ダブル・クリック　するんじゃないの？」

「　👆　あ、　有った」

「　じゃあ　Tape シートの A1 セルの値 A と背景色　白色　を取得して、
そのタプル（Tuple；組み）が StateTable シートの何行目にあるか探し出して
イミディエイト・ウィンドウに　デバッグプリント　するところまで　やりましょう！」

Sub ボタン1_Click()
    Dim text As String
    Dim backgroundColor As Long

    text = Worksheets("Tape").Range("A1").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("A1").Interior.color ' 背景色

    Debug.Print (text)
    Debug.Print (backgroundColor)

    Worksheets("GUI").Range("A1").Value = text
    Worksheets("GUI").Range("A1").Interior.color = backgroundColor
End Sub

「　👆　値と　背景色のコピーは　できるようになったが、
次は　探すというやつだな」

「　🔍 VBA For文 で検索」

📖 [Excel で VBA] For 文による繰り返し

「　👆　よし　分かったぜ」

「　For文 が何かの説明は　しないのね」

「　手を動かせば　分かるぜ」

「　👆　多分　StateTable シートを　１行目から　７行目まで読むのは　こんな雰囲気だろ。
VBA の if 文ってどうやって書くんだったかな？」

「　記憶してないの　わらう」

「　🔍 VBA if文 で検索」

📖 ExcelのVBA（マクロ）でIf～Then～Elseを使って条件分岐する方法

「　👆　よし　分かったぜ」

「　👆　多分　if文は　こんな雰囲気だろ。
Forループを途中で抜けるの　VBAで　どうやって書くんだったかな？」

「　ググりゃいいんじゃないの？」

「　なんにも覚えてないんだな」

「　🔍 VBA break文 で検索」

📖　Excel VBAでFor文を途中で抜ける：Exit

「　👆　よし　分かったぜ」

Sub ボタン1_Click()
    Dim text As String
    Dim backgroundColor As Long

    text = Worksheets("Tape").Range("A1").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("A1").Interior.color ' 背景色

    Debug.Print (text)
    Debug.Print (backgroundColor)

    Worksheets("GUI").Range("A1").Value = text
    Worksheets("GUI").Range("A1").Interior.color = backgroundColor

    Dim i As Long
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value ' セルの値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color ' 背景色

        ' 一致するか？
        If text = stateText And backgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color ' 背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value ' セルの値
            transitionText = Worksheets("StateTable").Range("E" & i).Value ' セルの値

            Debug.Print (writeBackgroundColor)
            Debug.Print (moveText)
            Debug.Print (transitionText)

            ' TODO 次の処理へ

            Exit For
        End If
    Next i
End Sub

「　👆　取れてるぜ」

📅 2023-01-25 wed 23:00

「　次は、
Tape シートの A1 セルを　スタート地点として、
１行　下りたセルの背景色を　Write列のいう色に塗って、そこから
Move 列が > だったらその右のセルへ、 Transition 列のいうテキストを入れましょう」

「　👆　こんな感じだろ」

「　👆　Tape シートの２行目を　クリアーしておくぜ。
そして GUI シートのボタンを押すぜ」

「　👆　色も文字もコピーされたぜ」

「　おつ。
長いコンボが決まったな」

「　これで　１クロック　よね」

「　何だぜ　それ」

「　次は　２クロック目に　行ってみようぜ？」

📅 2023-01-25 wed 23:21

「　👆　B2 セルをスタート地点として、　同様に　さっきと同じことを　やればいいんだぜ」

「　嫌だぜ　なんでそんなことをするんだぜ？」

「　ラジオ体操　みたいなもんよ。　頭を　ほぐしてんのよ」

「　👆　文字が B で、背景色が　白色　なのは　４行目だな。
下にオレンジ塗って　左へ　A　を書けばよさそうだな」

「　👆　説明するのを忘れていたが、上の行の背景色を、下の行へ　引き継ぐぜ」

「　忘れないでくれだぜ」

「　👆　下にオレンジ塗るぜ」

「　👆　左に　A　を書いたら　こんな感じだな」

Sub ボタン1_Click()
    Dim text As String
    Dim backgroundColor As Long
    Dim i As Long
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String

    ' 1回目の処理
    text = Worksheets("Tape").Range("A1").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("A1").Interior.color ' 背景色

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value ' セルの値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color ' 背景色

        ' 一致するか？
        If text = stateText And backgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color ' 背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value ' セルの値
            transitionText = Worksheets("StateTable").Range("E" & i).Value ' セルの値

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range("A2").Interior.color = writeBackgroundColor

            ' Move 列が `>` だったら その右のセルへ、 Transition 列のいうテキストを入れる
            If moveText = ">" Then
                Worksheets("Tape").Range("B2").Value = transitionText
            End If

            Exit For
        End If
    Next i

    ' TODO ★ 同様の2回目の処理
    text = Worksheets("Tape").Range("B2").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("B2").Interior.color ' 背景色

    ' ★ 上の行の背景色は引き継ぐ
    Worksheets("Tape").Range("A3").Interior.color = Worksheets("Tape").Range("A2").Interior.color
    Worksheets("Tape").Range("B3").Interior.color = Worksheets("Tape").Range("B3").Interior.color

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value ' セルの値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color ' 背景色

        ' 一致するか？
        If text = stateText And backgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color ' 背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value ' セルの値
            transitionText = Worksheets("StateTable").Range("E" & i).Value ' セルの値

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range("B3").Interior.color = writeBackgroundColor

            ' ★ Move 列が `<` だったら その左のセルへ、 Transition 列のいうテキストを入れる
            If moveText = "<" Then
                Worksheets("Tape").Range("A3").Value = transitionText
            End If

            Exit For
        End If
    Next i

End Sub

「　👆　それを　コードにしたら　こんな感じだぜ」

「　長い」

「　これで　２クロック　よね」

「　何だぜ　それ」

「　次は　３クロック目に　行ってみようぜ？」

「　嫌だぜ」

「　今日は　ここまでとするが、　３クロック目　行くからな」

📅 2023-01-25 wed 23:51 end

📅2023-01-26 thu 18:53 start

「　VBA でサブルーチンは　どうやって書いたらいいんだぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA サブルーチン で検索」

📖 Excel VBA 処理の一部をサブルーチン化するCallステートメント

「　👆　よし　分かったぜ」

「　👆　スケルトン（Skeleton；穴埋めの穴じゃない方）を書こうぜ」

「　👆　スケルトンの中へ　コードを　こうやって　入れたらいいんじゃないかだぜ？」

「　👆　つまり　こう」

「　👆　移動した跡の所には　コール文（Call Statement）を置いておこうぜ？」

Sub ボタン1_Click()

    ' 1回目の処理
    Call On1stClock

    ' 同様の2回目の処理
    Call On2ndClock

End Sub

Private Sub On1stClock()
    ' １回目のクロック
    Dim text As String
    Dim backgroundColor As Long
    Dim i As Long
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String

    text = Worksheets("Tape").Range("A1").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("A1").Interior.color ' 背景色

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value ' セルの値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color ' 背景色

        ' 一致するか？
        If text = stateText And backgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color ' 背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value ' セルの値
            transitionText = Worksheets("StateTable").Range("E" & i).Value ' セルの値

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range("A2").Interior.color = writeBackgroundColor

            ' Move 列が `>` だったら その右のセルへ、 Transition 列のいうテキストを入れる
            If moveText = ">" Then
                Worksheets("Tape").Range("B2").Value = transitionText
            End If

            Exit For
        End If
    Next i

End Sub

Private Sub On2ndClock()
    ' ２回目のクロック
    Dim text As String
    Dim backgroundColor As Long
    Dim i As Long
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String

    text = Worksheets("Tape").Range("B2").Value ' セルの値
    backgroundColor = Worksheets("Tape").Range("B2").Interior.color ' 背景色

    ' ★ 上の行の背景色は引き継ぐ
    Worksheets("Tape").Range("A3").Interior.color = Worksheets("Tape").Range("A2").Interior.color
    Worksheets("Tape").Range("B3").Interior.color = Worksheets("Tape").Range("B3").Interior.color

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value ' セルの値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color ' 背景色

        ' 一致するか？
        If text = stateText And backgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color ' 背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value ' セルの値
            transitionText = Worksheets("StateTable").Range("E" & i).Value ' セルの値

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range("B3").Interior.color = writeBackgroundColor

            ' ★ Move 列が `<` だったら その左のセルへ、 Transition 列のいうテキストを入れる
            If moveText = "<" Then
                Worksheets("Tape").Range("A3").Value = transitionText
            End If

            Exit For
        End If
    Next i
End Sub

「　じゃあ　GUI シートのボタンを押そうぜ？」

「　👆　ちゃんと動いてるな」

「　場所を移しただけだしな」

📅2023-01-26 thu 19:16

「　３クロック目も　コピー貼り付けして作んの？」

「　嫌になるだろ」

「　👆　何回目のクロックでも使えるジェネラル（General）なサブルーチンを作ろうぜ？」

「　👆　違うところは５か所ぐらいなんだから、ここを違わないようにすればいいわけだぜ」

「　Ａ列の右隣は B列だが、
A の右は何か尋ねたら B が返ってくるような方法って VBA にあるのかだぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA 列アルファベット変換 で検索」

📖 【ExcelVBA】列名のアルファベットと列番号の数字を相互変換する

「　👆　よし　分かったぜ」

Sub ボタン1_Click()

    ' 1回目の処理
    Call OnClock("A", 1)

    ' 同様の2回目の処理
    Call OnClock("B", 2)

End Sub

Private Sub OnClock(previousFileAlphabet As String, previousRank As Long)
    ' TODO 毎クロック（ｎ回目のクロック）
    Dim previousText As String
    Dim previousBackgroundColor As Long
    Dim previousCell As String
    Dim currentRank As Long
    Dim currentCell As String
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String
    Dim i As Long

    previousCell = previousFileAlphabet & previousRank
    currentRank = previousRank + 1
    currentCell = previousFileAlphabet & currentRank
    Debug.Print ("--------")
    Debug.Print ("previousFileAlphabet:" & previousFileAlphabet)
    Debug.Print ("previousRank        :" & previousRank)
    Debug.Print ("previousCell        :" & previousCell)
    Debug.Print ("currentRank         :" & currentRank)
    Debug.Print ("currentCell         :" & currentCell)

    ' 開始行の背景色は、次行に引き継ぐ
    If 2 <= previousRank Then
        Dim aBackgroundColor As Long
        Dim bBackgroundColor As Long
        aBackgroundColor = Worksheets("Tape").Range("A" & previousRank).Interior.color
        bBackgroundColor = Worksheets("Tape").Range("B" & previousRank).Interior.color
        Worksheets("Tape").Range("A" & currentRank).Interior.color = aBackgroundColor
        Worksheets("Tape").Range("B" & currentRank).Interior.color = bBackgroundColor
        Debug.Print ("aBackgroundColor:" & aBackgroundColor)
        Debug.Print ("bBackgroundColor:" & bBackgroundColor)
    End If

    previousText = Worksheets("Tape").Range(previousCell).Value                             ' 開始セルの値
    previousBackgroundColor = Worksheets("Tape").Range(previousCell).Interior.color         ' 開始セルの背景色
    Debug.Print ("previousText           :" & previousText)
    Debug.Print ("previousBackgroundColor:" & previousBackgroundColor)

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value                           ' 状態テーブルのState値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color        ' 状態テーブルのRead列の背景色
        Debug.Print ("stateText           :" & stateText)
        Debug.Print ("readBackgroundColor :" & readBackgroundColor)

        ' 一致するか？
        If previousText = stateText And previousBackgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color   ' 状態テーブルのWrite列の背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value                        ' 状態テーブルのMove列の値
            transitionText = Worksheets("StateTable").Range("E" & i).Value                  ' 状態テーブルのTransition列の値
            Debug.Print ("writeBackgroundColor:" & writeBackgroundColor)
            Debug.Print ("moveText            :" & moveText)
            Debug.Print ("transitionText      :" & transitionText)

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range(currentCell).Interior.color = writeBackgroundColor

            Dim horizontal As Long      ' 水平方向
            If moveText = ">" Then      ' Move 列が `>` だったら その右のセルへ
                horizontal = 1
            ElseIf moveText = "<" Then  ' Move 列が `<` だったら その左のセルへ
                horizontal = -1
            End If
            Debug.Print ("horizontal:" & horizontal)

            ' Transition 列のいうテキストを入れる
            Dim startFileNumber As Integer
            Dim nextFileAlphabet As String
            startFileNumber = Columns(previousFileAlphabet).Column
            nextFileAlphabet = Split(Cells(1, startFileNumber + horizontal).Address, "$")(1)
            Debug.Print ("startFileNumber :" & startFileNumber)
            Debug.Print ("nextFileAlphabet:" & nextFileAlphabet)
            Worksheets("Tape").Range(nextFileAlphabet & currentRank).Value = transitionText

            Exit For
        End If
    Next i
End Sub

「　👆　けっこう　大がかりに　変えることになってしまったぜ」

📅2023-01-26 thu 21:12

「　こんなん　何がどう変わったのか　読者　分からんだろ」

「　👆　１クロック目と　２クロック目で違うところは、　スタート地点の列番号と、行番号だけだったということだぜ」

「　このように　２つのサブルーチンの差異が　サブルーチンの外に押し出されたものを　アーギュメント（Argument；実引数）と呼ぶ」

「　ふーん」

「　３クロック目は　どう書くの？」

「　👆　A1 とか B2 というのは、１クロック前に居たセルだぜ。
だから　前の計算結果を　もらうといい。
書き直そう」

「　VBA でファンクションは　どうやって書いたらいいんだぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA ファンクション で検索」

📖 VBA　Functionプロシージャについて　～関数の解説と使用例～

「　👆　よし　分かったぜ」

Sub ボタン1_Click()

    Dim resultCell As String

    ' 1回目の処理
    resultCell = OnClock("A1")

    ' 同様の2回目の処理
    resultCell = OnClock(resultCell)

End Sub

Private Function OnClock(previousCell As String) As String
    ' 毎クロック（ｎ回目のクロック）
    Dim previousText As String
    Dim previousBackgroundColor As Long
    Dim currentRank As Long
    Dim currentCell As String
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String
    Dim i As Long

    previousFileAlphabet = Split(Cells(1, Range(previousCell).Column).Address, "$")(1)
    previousRank = Range(previousCell).Row
    currentRank = previousRank + 1
    currentCell = previousFileAlphabet & currentRank
    Debug.Print ("--------")
    Debug.Print ("previousCell        :" & previousCell)
    Debug.Print ("previousFileAlphabet:" & previousFileAlphabet)
    Debug.Print ("previousRank        :" & previousRank)
    Debug.Print ("currentRank         :" & currentRank)
    Debug.Print ("currentCell         :" & currentCell)

    ' 開始行の背景色は、次行に引き継ぐ
    If 2 <= previousRank Then
        Dim aBackgroundColor As Long
        Dim bBackgroundColor As Long
        aBackgroundColor = Worksheets("Tape").Range("A" & previousRank).Interior.color
        bBackgroundColor = Worksheets("Tape").Range("B" & previousRank).Interior.color
        Worksheets("Tape").Range("A" & currentRank).Interior.color = aBackgroundColor
        Worksheets("Tape").Range("B" & currentRank).Interior.color = bBackgroundColor
        Debug.Print ("aBackgroundColor:" & aBackgroundColor)
        Debug.Print ("bBackgroundColor:" & bBackgroundColor)
    End If

    previousText = Worksheets("Tape").Range(previousCell).Value                             ' 開始セルの値
    previousBackgroundColor = Worksheets("Tape").Range(previousCell).Interior.color         ' 開始セルの背景色
    Debug.Print ("previousText           :" & previousText)
    Debug.Print ("previousBackgroundColor:" & previousBackgroundColor)

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value                           ' 状態テーブルのState値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color        ' 状態テーブルのRead列の背景色
        Debug.Print ("stateText           :" & stateText)
        Debug.Print ("readBackgroundColor :" & readBackgroundColor)

        ' 一致するか？
        If previousText = stateText And previousBackgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color   ' 状態テーブルのWrite列の背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value                        ' 状態テーブルのMove列の値
            transitionText = Worksheets("StateTable").Range("E" & i).Value                  ' 状態テーブルのTransition列の値
            Debug.Print ("writeBackgroundColor:" & writeBackgroundColor)
            Debug.Print ("moveText            :" & moveText)
            Debug.Print ("transitionText      :" & transitionText)

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range(currentCell).Interior.color = writeBackgroundColor

            Dim horizontal As Long      ' 水平方向
            If moveText = ">" Then      ' Move 列が `>` だったら その右のセルへ
                horizontal = 1
            ElseIf moveText = "<" Then  ' Move 列が `<` だったら その左のセルへ
                horizontal = -1
            End If
            Debug.Print ("horizontal:" & horizontal)

            ' Transition 列のいうテキストを入れる
            Dim previousFileNumber As Integer
            Dim nextFileAlphabet As String
            Dim nextCell As String
            previousFileNumber = Columns(previousFileAlphabet).Column
            nextFileAlphabet = Split(Cells(1, previousFileNumber + horizontal).Address, "$")(1)
            nextCell = nextFileAlphabet & currentRank
            Debug.Print ("previousFileNumber :" & previousFileNumber)
            Debug.Print ("nextFileAlphabet   :" & nextFileAlphabet)
            Debug.Print ("nextCell           :" & nextCell)
            Worksheets("Tape").Range(nextCell).Value = transitionText

            ' 関数から抜ける
            OnClock = nextCell
            Exit Function

        End If
    Next i
End Function

「　👆　さらに　改造してしまったぜ」

📅2023-01-26 thu 21:43

「　こんなん　何がどう変わったのか　読者　分からんだろ」

「　👆　このように　前の計算結果を使って　また同様に計算するように作るのは　よくあるテクニックだぜ。
漸化式（ぜんかしき）とか　これだな」

「　さっさと　３クロック目を書きなさいよ」

「　👆　３クロック目は、２クロック目と同じコードで　いいはずなんだぜ。
動かしてみよう」

「　👆　エラーが出たぜ」

「　直せ！」

「　👆　[デバッグ（D）] ボタンを押してみようぜ？」

「　エラーがあった行をハイライト（Highlight）してくれてるのかもしれないけど　説明がないから分かんないわねぇ」

「　また　ショートカットを打鍵すれば　ウィンドウが出てくるのかだぜ？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA スタックトレース で検索」

📖 VBAナメてた

「　👆　行番号とエラーコードしか　分かんないらしいぜ」

「　1994年の環境ねえ」

📅2023-01-26 thu 22:01

「　🔍 VBA 1004 Error で検索」

📖 VBA Error 1004 in Excel

「　👆　無いシート名や、無いアドレスを指定したら　出てくるエラーかも知らん」

「　👆　A列より　左に進もうとして　０列目は無いので　エラーになったんだな」

「　A列の左に　列を挿入しろだぜ」

「　🔍 VBA 列の挿入 で検索」

📖 VBA 列を挿入する

「　👆　よし　分かったぜ」

「　👆　０列にアクセスしようとしたら、
A列の左に　列挿入して、　列番地も左に　１つずらして　１列にアクセスするように変更しよう」

「　👆　３クロック目も　動いたようだな」

📅2023-01-26 thu 22:18

「　じゃあ　あと　１００クロックぐらい　動かしましょう」

「　👆　For 文を使えば　１００行書かずに済むから楽だよな。
漸化式の形に作っておけば　繰り返しの回数を指定するだけでいいから　手間要らずだぜ」

「　👆　エラーが出た」

「　🔍 VBA 1004 Error で検索しろだぜ」

「　さっきと同じ 1004 番よ」

「　今度は何が無かったんだろな？」

「　👆　previousCell 変数の中身が空文字列だぜ。」

「　A1 とか、何か番地が入っているはずじゃない」

「　👆　リセット ボタンを押すと　デバッグは止まるぜ」

「　👆　多分、 HALT （ハルト）が出たら　終了しないといけないんだぜ」

            If transitionText = "HALT" Then
                ' 関数から抜ける
                OnClock = "SUCCESS"
                Exit Function
            End If

「　👆　じゃあ　HALT （ハルト）が出たときは　セル番地ではなく　SUCCESS　を返すという取り決めにしておこうぜ」

        ' 正常終了時はループから抜ける
        If resultCell = "SUCCESS" Then
            Exit For
        End If

「　👆　関数の呼び出し元でも　前判定で　resultCell 変数の内容が SUCCESS だったら、ループから抜けるようにすれば　コードも短いぜ」

「　👆　なんか　動いた跡があるな」

📖 Turing machine

「　👆　Wikipedia のサンプルと違くない？」

「　👆　A列と B列しか　背景色をコピーしてないからな」

「　テープの長さと同じ幅だけ　コピーしてくれだぜ」

「　じゃあ　テープの長さも　数えておかないといけないな」

「　VBA で、自由変数の使い方、または　引数の参照渡しのやり方は　どう書くんだろうな？」

「　ググりゃいいんじゃないの？」

「　🔍 VBA 引数の参照渡し で検索」

📖 値渡し（ByVal）、参照渡し（ByRef）について

「　👆　よし　分かったぜ」

「　ぜったい　そんな記事を　ちらっと読んでも　何も分からないけどな」

「　プログラムの組み方は分かってるが　VBA での書き方が分からないだけなんで、ちら見で　充分だぜ」

「　あれっ？　ByRef tapeWidth As Long　と書いても　参照渡しになって無（ね）。
調べても分からないことはある。
自由変数にするか」

「　🔍 VBA グローバル変数 で検索」

📖 変数の適用範囲

「　👆　よし　分かったぜ」

「　でも　書いているうちに　tapeWith　というスペルミスを見つけて　tapeWidth 直したら動くようになった」

Sub ボタン1_Click()

    Dim resultCell As String
    Dim tapeWidth As Long
    tapeWidth = 1   ' "A1" セル１つ分

    ' 1回目の処理
    resultCell = OnClock("A1", tapeWidth)

    ' 同様の i 回目の処理
    Dim i As Long
    For i = 2 To 100

        ' 正常終了時はループから抜ける
        If resultCell = "SUCCESS" Then
            Exit For
        End If

        resultCell = OnClock(resultCell, tapeWidth)
    Next i

End Sub

Private Function OnClock(previousCell As String, ByRef tapeWidth) As String
    ' 毎クロック（ｎ回目のクロック）
    Dim previousFileAlphabet As String
    Dim previousRank As Long
    Dim previousText As String
    Dim previousBackgroundColor As Long
    Dim currentRank As Long
    Dim currentCell As String
    Dim stateText As String
    Dim readBackgroundColor As Long
    Dim writeBackgroundColor As Long
    Dim moveText As String
    Dim transitionText As String
    Dim i As Long

    previousFileAlphabet = Split(Cells(1, Range(previousCell).Column).Address, "$")(1)
    previousRank = Range(previousCell).Row
    currentRank = previousRank + 1
    currentCell = previousFileAlphabet & currentRank
    Debug.Print ("--------")
    Debug.Print ("previousCell        :" & previousCell)
    Debug.Print ("previousFileAlphabet:" & previousFileAlphabet)
    Debug.Print ("previousRank        :" & previousRank)
    Debug.Print ("currentRank         :" & currentRank)
    Debug.Print ("currentCell         :" & currentCell)
    Debug.Print ("tapeWidth           :" & tapeWidth)

    ' 開始行の背景色は、次行に引き継ぐ
    If 2 <= previousRank Then
        For i = 1 To (tapeWidth + 1)
            Dim tempFileAlphabet As String
            Dim tempBackgroundColor As Long

            tempFileAlphabet = Split(Cells(1, i).Address, "$")(1)
            tempBackgroundColor = Worksheets("Tape").Range(tempFileAlphabet & previousRank).Interior.color
            Debug.Print ("i                  :" & i)
            Debug.Print ("tempFileAlphabet   :" & tempFileAlphabet)
            Debug.Print ("tempBackgroundColor:" & tempBackgroundColor)
            Worksheets("Tape").Range(tempFileAlphabet & currentRank).Interior.color = tempBackgroundColor
        Next i
    End If

    previousText = Worksheets("Tape").Range(previousCell).Value                             ' 開始セルの値
    previousBackgroundColor = Worksheets("Tape").Range(previousCell).Interior.color         ' 開始セルの背景色
    Debug.Print ("previousText           :" & previousText)
    Debug.Print ("previousBackgroundColor:" & previousBackgroundColor)

    For i = 2 To 7
        stateText = Worksheets("StateTable").Range("A" & i).Value                           ' 状態テーブルのState値
        readBackgroundColor = Worksheets("StateTable").Range("B" & i).Interior.color        ' 状態テーブルのRead列の背景色
        Debug.Print ("stateText           :" & stateText)
        Debug.Print ("readBackgroundColor :" & readBackgroundColor)

        ' 一致するか？
        If previousText = stateText And previousBackgroundColor = readBackgroundColor Then
            writeBackgroundColor = Worksheets("StateTable").Range("C" & i).Interior.color   ' 状態テーブルのWrite列の背景色
            moveText = Worksheets("StateTable").Range("D" & i).Value                        ' 状態テーブルのMove列の値
            transitionText = Worksheets("StateTable").Range("E" & i).Value                  ' 状態テーブルのTransition列の値
            Debug.Print ("writeBackgroundColor:" & writeBackgroundColor)
            Debug.Print ("moveText            :" & moveText)
            Debug.Print ("transitionText      :" & transitionText)

            ' `Tape` シートの A1 セルの下のセルの背景色を　Write列のいう色に塗る
            Worksheets("Tape").Range(currentCell).Interior.color = writeBackgroundColor

            Dim horizontal As Long      ' 水平方向
            If moveText = ">" Then      ' Move 列が `>` だったら その右のセルへ
                horizontal = 1
            ElseIf moveText = "<" Then  ' Move 列が `<` だったら その左のセルへ
                horizontal = -1
            End If
            Debug.Print ("horizontal:" & horizontal)

            ' Transition 列のいうテキストを入れる
            Dim previousFileNumber As Integer
            Dim nextFileAlphabet As String
            Dim nextFileNumber As Integer
            Dim nextCell As String
            previousFileNumber = Columns(previousFileAlphabet).Column
            nextFileNumber = previousFileNumber + horizontal
            Debug.Print ("previousFileNumber :" & previousFileNumber)
            Debug.Print ("nextFileNumber     :" & nextFileNumber)

            If nextFileNumber = 0 Then
                Worksheets("Tape").Columns("A").Insert  ' A 列の左に列挿入
                nextFileNumber = nextFileNumber + 1     ' 列番号を 1 つ左へずらす
                tapeWidth = tapeWidth + 1               ' Update
            ElseIf tapeWidth < nextFileNumber Then
                tapeWidth = nextFileNumber              ' Update
            End If

            nextFileAlphabet = Split(Cells(1, nextFileNumber).Address, "$")(1)
            nextCell = nextFileAlphabet & currentRank
            Debug.Print ("nextFileAlphabet   :" & nextFileAlphabet)
            Debug.Print ("nextCell           :" & nextCell)
            Worksheets("Tape").Range(nextCell).Value = transitionText

            If transitionText = "HALT" Then
                ' 関数から抜ける
                OnClock = "SUCCESS"
                Exit Function
            End If

            ' 関数から抜ける
            OnClock = nextCell
            Exit Function

        End If
    Next i
End Function

「　👆　よし　tapeWidth も付けたぜ」

「　👆　チューリング・マシンが　でけたぜ」

📅2023-01-27 thu 00:01

「　HALT は出力しないのが　チューリング・マシンみたいよ？」

「　じゃあ　StateTable　の　Transition　列で　HALT　を見つけたところで　止めた方がいいのか」

「　👆　判定部を　上に持っていけば　いいんじゃないかだぜ？」

「　👆　１行　余分に背景色をコピーしてるわよ？」

「　👆　背景色のコピーを、判定部の後ろに持っていけば　いいんじゃないかだぜ？」

「　👆　おっと」

「　👆　変数 i は、外側のループの　ループ・カウンターとして使ってたか」

「　👆　じゃあ　変数 j を作ればいいや」

「　👆　これで　チューリング・マシン　は完成だぜ。
一般化してないのと、不具合が残っているのが　残っているかも知れないが……」

「　これは何に使うんだぜ？」

「　👆　この例だと　長さ６のオレンジ色のテープを作るために使ったんだぜ。
説明しよう」

「　👆　この StateTable というのが　プログラムの命令セットのようなものだぜ。
この６行があると……」

「　👆　最初は A と書かれているが、
A にあんまり意味は無くて　長さ１つの白いテープがそこにあると思えだぜ」

「　👆　上の図は　テープを伸ばしている過程が描かれたもので、
最後の　１３行目が　作られたテープだぜ」

「　長さ６つのオレンジ色のテープ　が作られて　動作が止まったわけだぜ」

「　長さ６つのオレンジ色のテープ　なんか　作っても　嬉しくないしなあ」

「　今回はサンプルで　オレンジ色１色しかなかったが、
それが　２６色あって　アルファベットの２６文字に対応するとか、
最初から色の塗られたテープがあって　チューリング・マシンが動いた後には　別の色のテープが残っているとか、
それが　暗号を解読した答え　だったりしたら　嬉しいだろ」

「　じゃあ　今回の例題　がシンプルすぎて　チューリング・マシン　が何たるか　嬉しさが　分からないんだ」

「　プログラミング言語　が誕生する前の　プログラミング　方法だぜ」

「　私たちが使うのは　プログラミング言語　なのだから、懐古好きでもなければ　チューリング・マシン　を覚えなくてもいいのでは？」

「　一生のうちに　何回か　チューリング・マシン　とか　チューリング完全　の名前を聞くことはあるだろ。
記事を読んで知識として知ってるより　作って知ってる方が　話しに実感がこもるだろ」

「　実感　要らないから　実用的で　効率的な練習　無いのかなあ」

「　そんな実用的な Webサイトなら、他人が作るしな　」

「　プログラムも　コンピューターも無い時代に　ヒトが考えたプログラムを　体験　するぐらいね」

「　もっと面白い例題でやってほしい」

参考： 📖 Git Hub / TuringMachineByExcelVBA

＜おわり＞

Excel で円グラフを作成する

2021-06-05T13:22:14+09:00

Excel で円グラフを作る方法についてメモ。

手順

以下のようにある値が降順でソートされたサンプルデータがあったとします(使い回し)。

このデータから円グラフを作成します。まずはソートと同様にグラフに含めたいセルの範囲を選択します。

リボンの「挿入」タブから「2-D 円」を選択します。

グラフをクリックして「＋」ボタンから「データラベル」に進み、「その他オプション」をクリック。

「ラベルオプション」で「分類名」「パーセンテージ」にチェックを入れて、「区切り文字」を「(改行)」にします。

すると、円グラフに項目名とパーセンテージが出るようになるので、どれがどの項目でどのくらいの割合なのか一目で分かるようになるかと思います。

また、「ラベルの位置」を「外部」にすることで文字とグラフの塗り潰し色のバッティングを回避します(なお、ラベルテキストの文字色を各項目ごとに変更することはできないようです。濃い色ならば文字色を白、淡い色ならば黒、としたかったのですが……)。

「凡例」を右にします。この辺りは好みで。

円グラフ内のパイを選択して右クリック、「塗り潰し」で色を変更します。

ラベルの位置や吹き出し線を調整してそこそこ形になりました (色は適当)。

Excel で行方向の値をソートする

2021-06-05T13:15:28+09:00

表題の通り、 Excel で行方向に並んだ値をソートする方法についてメモ。

経緯

例えば、以下のようなサンプルデータがあったとします。

これを、「カウント」の降順にソートしたい。

手順

まずソートしたい項目を範囲選択します(見出し項目と値の双方を含めて)。

次に、リボンの中から「データ」タブをクリックし、「並び替え」をクリック。

「オプション」ボタンをクリックして詳細を表示させます。

「方向」を「列単位」に変更します。

「並べ替え」のダイアログの見出しが「列」から「行」に変わったので、「優先されるキー」を2行目、「順序」を「大きい順」にして「OK」。

無事、降順でソートされました。

情報系資格対策兼DB復習の足跡🐈 🐾02

2021-04-21T23:09:49+09:00

``
初日から飛ばしてしまい、奇々怪々な投稿してしまったこと、お詫び申し上げます。

さて、前回の続きです。今回はわりかし真面目にいきます😢

v目次にゃv

スクレイピングでWEBからデータを抽出
Excelでクエリ作成
テーブル作成

スクレイピングでWEBからデータを抽出だニャー(=✧ω✧=)
今回は応用情報.comさんのサイトから午前問題の答えを抽出しました。
Pythonを用いてスクレイピングです。
ライブラリをインポートしたら手早く作っちゃいますにゃんこ～🐱

プログラムを組むと作業で楽でいいニャー•v-v•
（下の”エウウウ”が抽出している回答です）

Excelでクエリ作成
1文ずつ手入力してしまうと、猫の手も借りたい現象が起きてしまうので、今回はExcelを活用します。
今回は既にExcelにて材料がテーブルとして用意してあるので、CONCATENATE関数を用いてSQL文と結合してクエリを作成するぎょぴよฅ^•ω•^ฅ

先程、抽出した回答をExcelテーブル”originalans”列にコピペ。
その後、必要なSQL文の文字を空きセルに用意し結合するキツネ～🦊

テーブル作成
上の工程で出来たクエリをMySQLにコピペするにゃ～
にゃっ！テーブルを1つ作成完了ねこ！！！

（スペルミス、命名規約、正規化不足、語訳、見づらさについては大目にみていただけると幸いです。）

今日はここまで🐾
今回使用したスクレイピング、DB等々、詳しく知りたいとご要望があれば、猫でもわかるように説明するかもです。

これからも頑張るきんぎょー
``

WordPress で一部の .xlsファイルだけがアップロードできない (解決)

2021-04-18T17:11:54+09:00

前回の続きです。プラグインを作成しましたが、挙動が変わらなかったためさらに調査を続行しました。

結果

結果から記すと、プラグインを以下のように改修することで解決できました。

 'application/vnd.ms-office'
            ],
            [
                'xla|xls|xlt|xlw' => 'application/vnd.ms-excel'
            ],
        ];
    }
    /**
     * Bibishii                  : フィルター追加
     *
     * @param {Object} $check    : MIMEタイプ の一覧のオブジェクト
     * @param {File} $file       : チェック対象ファイル
     * @param {Object} $filename : チェック対象ファイルの名前
     *
     * @return {Object}          : 誤判定している MIME タイプを追記する
     *
     */
    public function Bibishii ( $check, $file, $filename )
    {
        if ( empty( $check['ext'] ) && empty( $check['type'] ) ) {
            foreach ( self::Vivid() as $mime ) {
                remove_filter(
                    'wp_check_filetype_and_ext',
                    [
                        $this,
                        'Bibishii'
                    ],
                    99
                );
                $mime_filter = function($mimes) use ($mime) {
                    return array_merge($mimes, $mime);
                };

                add_filter(
                    'upload_mimes',
                    $mime_filter,
                    99
                );
                $check = wp_check_filetype_and_ext( $file, $filename, $mime );
                remove_filter(
                    'upload_mimes',
                    $mime_filter,
                    99
                );
                add_filter(
                    'wp_check_filetype_and_ext',
                    [
                        $this,
                        'Bibishii'
                    ],
                    99,
                    3
                );
                if ( ! empty( $check['ext'] ) || ! empty( $check['type'] ) ) {
                    return $check;
                }
            }
        }

        return $check;
    }
}

// instantiate
$ab_wp_plugin_mimeuruwashii = new MIMEuruwashii();

元の原型ないですね。引っかけるアクションフックも upload_mimes から wp_check_filetype_and_ext に変わっています。

調査

調査の過程を以下に記します。

挙動が変わらなかった理由を wp-includes/functions.php を追いかけて調べて行きます。

メソッドwp_get_mime_types() では拡張子と MIMEタイプをそれぞれキー・値として持つ連想配列を返却しています
wp_get_mime_types() が呼ばれている場所を辿っていきます
- get_allowed_mime_types() はいくつかの処理( .swf や .exe の除外、ユーザ権限がない場合は .html, .htm, .js を除外)をした後に upload_mimes でチェックする拡張子と MIMEタイプを登録
- do_enclose() は動画関連のチェックのように見えます。しかし、ここで気になるコードを発見
  - 拡張子の方は if ( preg_match( '!^(' . $exts . ')$!i', $extension ) ) で正規表現による判定を行っている (例えば !^(xla|xls|xlt|xlw)$!i のような形式)
  - 一方、 MIMEタイプは $type = $mime; で代入しているだけ
    - しかも break; している

上述のコードを見て、「ひょっとして複数の MIMEタイプを想定していないのでは？」と思い至り、検索。

WordPressでファイルアップロードができない(m4b、m4a、vtt、key） - Qiita
- uploads - How to assign multiple file-mime-types to extension? - WordPress Development Stack Exchange

やはり1つの拡張子に対して複数の MIMEタイプを持つ場合に対応していない (今回のケースで言うと「 .xlsファイルは application/vnd.ms-excel または application/vnd.ms-office を受け付ける」としたい) ようです。

前回のように MIMEタイプを付け足す方法は、 .ai や .psd のような、デフォルトの連想配列に拡張子がキーとして存在しない MIMEタイプならば良いと思います。しかし、今回の .xls のように既存の拡張子の場合は最後に付け足したキーまで評価されていなさそうです。

そこで、上述記事のように前回の upload_mimes 時に判定する MIMEタイプを付け足すのではなく、そもそものチェック処理の wp_check_filetype_and_ext を変更する、という方針に転換しました。

その結果が冒頭のプラグインのコードとなります。

雑感

複数の MIMEタイプが想定されていない作りということを初めて知って驚きました。

上述の Stackoverflow でも取り上げられていますが、 .svg や .zip 等他にも類似のケースが考えられるので意外でした。

参考

WordPress で一部の .xlsファイルだけがアップロードできない (失敗)

2021-04-17T13:25:24+09:00

WordPressサイトで一部の .xlsファイルだけがアップロードできない現象に遭遇したため、対処しました。

現象

とある WordPressサイトで .xlsファイルをアップロードしようとすると以下のエラーが表示されました。

“XXXXXXXXXXX.xls” のアップロードに失敗しました。

このファイルタイプはセキュリティ上の理由から、許可されていません。

しかも困ったことに、「Aの .xlsファイルはOKだが、Bの .xlsファイルはNG」というように、ファイルによって現象が分かれました。

両方とも正常に開ける .xlsファイルですし、見た目上は同じなのですが……。

対処1

最初の対処として、 wp-config.php にファイルアップロードの際のフィルタリングをオフにする方法を試しました。



これでファイルアップロードを試したところ、2つの .xlsファイル 共にアップロードできるようになりました。

ただし、この方法ですとファイルアップロードの際のフィルタ処理を全てオフにしてしまうため、セキュリティ的に好ましくありません。

そこで、もう少し調査を続けることにしました。

検証

上述の対処1より、ファイルアップロードの際のフィルタリング処理で引っかかっていることは分かりました。


【WordPress】アップロード可能なファイル拡張子を増やす | deep-space.blue


このフィルタリングは、拡張子と MIMEタイプ の判定をしているということが分かりました。

ファイルとしては、 wp-includes/functions.php です。


WordPress/functions.php at master · WordPress/WordPress · GitHub


中身を見て、関数 wp_get_mime_types() で拡張子と MIMEタイプ の一覧を持っていることが分かります。

この処理にアクションフックを引っかけることができれば良さそうです。

MIMEタイプ の確認

次に、問題のファイルの MIMEタイプ を確認します。

試しに、以下のような構成を作ります。

   /
  ├ files/
  │    ├ sample1.xls  // ファイルアップロード OK の .xlsファイル
  │    └ sample2.xls  // ファイルアップロード NG の .xlsファイル
  │
  └ index.php


また、 index.php を


ファイルの種類（MIMEタイプ）を確認する | GRAYCODE PHPプログラミング


この記事を参考にして、以下のようにします。

 $value) {
    echo $value . ": ";
    echo $finfo->file( $value, FILEINFO_MIME_TYPE );
    echo "

\n\n";
}



これを問題が発生している WordPressサイト と同じサーバにアップロードします。



すると、ファイルアップロード OK の .xlsファイルは MIMEタイプが application/vnd.ms-excel だったのに対し、 NG だった .xlsファイル は application/vnd.ms-office でした。



ちなみに、他の環境に同じファイル群をアップロードしたところ両方とも application/vnd.ms-excel で、この環境では今回の現象は発生しませんでした。


よくある MIME タイプ - HTTP | MDN


MIMEタイプ は .xls の場合 application/vnd.ms-excel のはずですが……。


  先に結論から言ってしまえば、利用しているサーバーのPHPのバージョンが低く、PHPの中で呼び出される「Fileinfo」というファイル操作のモジュールのバージョンが低かった為、アップロードしたエクセルファイルの正しいMIMEタイプが認識がされていないという状態になっていました。
  
  WordPressのメディアにアップロードが出来ない時 | スタッフブログ | 株式会社クーネルワーク


PHP のバージョンによって Fileinfoモジュール の判定結果が異なるとのこと。 WordPress の MIMEタイプ 判定もこのモジュールを得利用しているとのことで、ここで影響を受けてしまうようです。

以上より、今回の環境では本来 application/vnd.ms-excel となるべき MIMEタイプ が、何故か application/vnd.ms-office と判定され、結果、 WordPress のファイルアップロードの際のフィルタリング処理の中の MIMEタイプ 判定で引っかかっていた、というのが今回の現象の原因でした。

対処2

以上の検証を踏まえて対処をします。具体的には、アクションフックでファイルアップロードの際のフィルタリング処理の際に application/vnd.ms-office も許可するようなプラグインを作成します。



このプラグインを .zip でアップロード、インストールして有効化します。

もちろん、 wp-config.php の ALLOW_UNFILTERED_UPLOADS の行は削除して試験しました。

……が、挙動は変わらず、解決できませんでした。

参考

ALLOW_UNFILTERED_UPLOADS


WordPressの「セキュリティ上の理由によりこのファイル形式は許可されません」エラーの処理方法
WordPressのメディアにアップロードが出来ない時 | スタッフブログ | 株式会社クーネルワーク


WordPress 内のファイルアップロードのフィルタ処理について


【WordPress】アップロード可能なファイル拡張子を増やす | deep-space.blue
WordPress/functions.php at master · WordPress/WordPress · GitHub


Fileinfoモジュール による MIMEタイプ 判定


ファイルの種類（MIMEタイプ）を確認する | GRAYCODE PHPプログラミング


MIMEタイプ の一覧


よくある MIME タイプ - HTTP | MDN



Excel 内のハイパーリンクを踏むと IE 扱いされる
2021-04-04T11:49:41+09:00
Excel 内のハイパーリンクを踏むと、 Chrome で開いているのに IE 扱いされる現象に遭遇しました。

現象

上述の通りですが、


Excel の中でオレオレ証明書の https 始まりのハイパーリンクを設定する
1.のハイパーリンクを開く


とすると、 .htaccess でユーザエージェントで IE のみリダイレクトして専用ページを開く仕掛けが発動してしまいました。……実際ページを開いているブラウザは Chrome や Vivaldi なのに……。

検証

この現象について少し調べてみました。

試しに、以下のような アクセス元のユーザエージェント + HTTPメソッド を log/test.log というファイルに追記していく PHPコード を作成し、ここに 各Office製品 からハイパーリンク越しでアクセスしてみました。

 $value) {
    $str .= $key . ': ' . $value . "\n";
}
if(array_key_exists('User-Agent', $requestHeaders)) {
    $log .= 'User-Agent: ' . $requestHeaders['User-Agent'];
}
if(array_key_exists('Accept', $requestHeaders)) {
    $log .= ', Accept: ' . $requestHeaders['Accept'];
}
if(array_key_exists('Referer', $requestHeaders)) {
    $log .= ', Referer: ' . $requestHeaders['Referer'];
}
if(array_key_exists('Method', $requestHeaders)) {
    $log .= ', Method: ' . $requestHeaders['Method'];
}
$log .= ';';
$filepath = __DIR__ . '/log/test.log';
$current = '';
if(file_exists($filepath)) {
    $current = file_get_contents($filepath);
    $current .= "\n\n" . $log;
}
else {
    $current = $log;
}
file_put_contents($filepath, $current);
?>



    
    
    
    Document


    
        <?= $str; ?>
    
    
        
    
    




検証結果

Excel 2016 (httpsリンク、オレオレ証明書)

User-Agent: Microsoft Office Protocol Discovery, Method: OPTIONS;

User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.2; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729; ms-office), Accept: */*, Method: GET;

User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.186 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


最後のユーザエージェントは Chrome のものなので問題ないのですが、問題はその前。


OPTIONSメソッド で Microsoft Office Protocol Discovery なるユーザエージェントでリクエストが飛んでくる
GETメソッド で MSIE や Trident を含む (今回はこの2つで IE 判定をしていた) IE のようなユーザエージェントでリクエストが飛んでくる
Chrome 本体のリクエスト


という順番のようです。特に2番目。 IE そのものとはまた異なりますが、 IE と判定されそうな文字列を含むユーザエージェントです。これによりリダイレクト判定に引っかかり、リダイレクトした後の URL が Chrome に渡されるため、「 IE 扱いされた」挙動となったようです。

……何故こんなことに……。





ちなみに。

Excel 2016 (httpリンク)

User-Agent: Microsoft Office Excel 2014, Method: HEAD;

User-Agent: Mozilla/4.0 (compatible; ms-office), Accept: */*, Method: GET;

User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.82 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


こちらは MSIE や Trident といった文字列がユーザエージェントに出てこないため、 Chrome で正常に表示ができました。

ちなみに、本来のブラウザのアクセス前に飛ぶリクエストも OPTIONSメソッド ではなく HEADメソッド で飛んできています。

Word 2016 (https, http)

User-Agent: Microsoft Office Word 2014, Method: HEAD;

User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.82 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


Word 2016 については httpリンク の Excel と同様 MSIE や Trident といった文字列がユーザエージェントに出てきませんでした。





Excel 2013 (httpsリンク、オレオレ証明書)

User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729; Tablet PC 2.0; ms-office), Accept: */*, Method: GET;

User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.116 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


Excel 2013 だと OPTIONSメソッド が見当たりません。ただ、 MSIE や Trident が含まれているのは確認できます。

Excel 2013 (httpリンク)

User-Agent: Microsoft Office Excel 2013 (15.0.5319) Windows NT 10.0, Method: HEAD;

User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.116 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


こちらは 2016 と変わらなそうです。

Word 2013 (httpsリンク、オレオレ証明書)

User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729; Tablet PC 2.0; ms-office), Accept: */*, Method: GET;

User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.116 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


Word 2013 はなんと Excel 2013 と同じ結果に。これだと MSIE や Trident が含まれています。

Excel 2013 (httpリンク)

User-Agent: Microsoft Office Word 2013 (15.0.5319) Windows NT 10.0, Method: HEAD;

User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 10.0; WOW64; Trident/7.0; .NET4.0C; .NET4.0E; .NET CLR 2.0.50727; .NET CLR 3.0.30729; .NET CLR 3.5.30729; Tablet PC 2.0; ms-office), Accept: */*, Method: GET;

User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.116 Safari/537.36, Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9, Method: GET;


さらに Word 2013 で httpリンク の場合、 HEADメソッドが飛ぶのは Excel2013 と同様ですが、その後に MSIE や Trident を含む GETリクエストが飛んでいます。

これだとユーザーエージェント判定で引っかかることになりますね……。



手元の環境では、同じ Office製品 でもバージョンで挙動が異なるというかなり困った結果が得られてしまいました……。

Office製品 からのハイパーリンクを気にすることはほとんどないとは思うのですが、このような事象もあるということでメモしておきます。

参考


エクセルシートのリンクを使ってアクセスした場合に、保証の切れたインターネットエクスプローラーと認識され、アクセス - マイクロソフト コミュニティ
[Office用アプリ]User Agent他を調べてみました。 | 初心者備忘録
ExcelのWebクエリからのアクセス情報 | 初心者備忘録



【シリアル値】エクセルファイルで、日付の項目に謎の数値が入っていて困惑した時
2020-12-20T18:34:18+09:00
日付の項目が数値になってる



なにこれ？？？

シリアル値っていうらしいよ

1900年1月1日を「1」として、そこからの経過日数を数値化したものをシリアル値というらしい。



phpで日付型に変換

エクセルをインポートしてDBに登録する際には日付で登録したいので、

シリアル値から日付型に変換する。

$date = date('Y年m月d日', ($serial - 25569) * 60 * 60 * 24);


参考：https://qiita.com/shy_azusa/items/c78bb79c3dc6ac0585bd

「Excel」の記事 - Crieit

【実況ブログ】 Excel VBAで初めてのプログラミングを覚えようぜ（＾～＾）？

Excel で円グラフを作成する

Excel で行方向の値をソートする

情報系資格対策兼DB復習の足跡🐈 🐾02

WordPress で一部の .xlsファイル だけがアップロードできない (解決)

WordPress で一部の .xlsファイル だけがアップロードできない (失敗)

Excel 内のハイパーリンクを踏むと IE 扱いされる

【シリアル値】エクセルファイルで、日付の項目に謎の数値が入っていて困惑した時

WordPress で一部の .xlsファイルだけがアップロードできない (解決)

WordPress で一部の .xlsファイルだけがアップロードできない (失敗)