化学反応式の量的関係 とりあえず完了

コードが長いです(;´▽｀A``
正規表現を使っているのでMicrosoft VBScript Regular Expressions 5.5への参照設定が必要です。

コードが長すぎるため，最初に書きたいだけ書きます。

新規のプレゼンテーションに標準モジュールを追加し，そこにペタッと下記のコードを貼ります。

問題集作成マクロを実行すると，

こんなものが作られます。スライドショーを実行しましょう。

右側に並んでいる緑の番号を押すとその化学反応式が選ばれます。
そしたら，次の画面に移る。

5,7,9,11行目の白いセル?のどこかをクリックすると，そこに数値を入れれます。
画面切り替えを止めていないので，押せないところを押さないように気を付けましょう。スライドショーが終わりに向かいます。

マクロでやればよかったんですが，クリックしても画面切り替えしないように設定するといいと思われます。

表示を押すと，

表が埋まる。

数値は何度でも変えれるので，いろんな数値が試せます。個数の時は 6.0×10^23 なら 6e23 とか入力してください。

ツカレタ。。

マクロが長いせいか，なんにもなくてもパワーポイントが再起動することがあります。

このへんは，変わらないですね。。

どうしてなんでしょう( ´ー｀)ﾌｩｰ．．．

そうそう，個数はあまり物質量がとんでもない数値にならない程度で許してあげてください(;´▽｀A``

全てを指数表示にしたら耐えれますが，今はそのようになっていません。

気体の体積は四捨五入した値がピンと来ない子が多いため，有効数字を他のものと統一していません。

けっこう適当な感じです(;´▽｀A``

Const 行数 = 11, 列数 = 6, 行高さ = 49, 列幅 = 160
Const 原子量 = "H,1,C,12,N,14,O,16,Na,23,Mg,24,Al,27,P,31,S,32,K,39,Cl,35.5,Ca,40,Mn,55,Fe,56,Cu,64,Zn,65"
Const NA As Single = 6# * 10 ^ 23
Sub 問題集作成()
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Sld1.Shapes.Range.Delete
    If ActivePresentation.Slides.Count = 1 Then ActivePresentation.Slides.Add 2, ppLayoutBlank
    Dim 問題テーブル As Table
    
        
    With Sld1.Shapes.AddTable(11, 2)
        .Table.Columns(1).Width = 77
        .Table.Columns(2).Width = 771
        .Name = "問題テーブル"
        Set 問題テーブル = .Table
        Dim i
        For i = 1 To 10
            .Table.Cell(1 + i, 1).Shape.TextFrame.TextRange.Text = i & ")"
            .Table.Rows(i + 1).Height = 46.5
            .Table.Cell(1 + i, 2).Shape.TextFrame.VerticalAnchor = msoAnchorMiddle
        Next
    
        .Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = "N2+3H2→2NH3"
        .Table.Cell(3, 2).Shape.TextFrame.TextRange.Text = "CH4+2O2→CO2+2H2O"
        .Table.Cell(4, 2).Shape.TextFrame.TextRange.Text = "2H2S+SO2→3S+2H2O"
        .Table.Cell(5, 2).Shape.TextFrame.TextRange.Text = "2Al+6HCl→2AlCl3+3H2"
        .Table.Cell(6, 2).Shape.TextFrame.TextRange.Text = "MnO2+4HCl→MnCl2+2H2O+Cl2"
        .Table.Cell(7, 2).Shape.TextFrame.TextRange.Text = "P4O10+6H2O→4H3PO4"
        .Table.Cell(8, 2).Shape.TextFrame.TextRange.Text = "4Al+3O2→2Al2O3"
        .Table.Cell(9, 2).Shape.TextFrame.TextRange.Text = "2KClO3→2KCl+3O2"
        .Table.Cell(10, 2).Shape.TextFrame.TextRange.Text = "C3H8+5O2→3CO2+4H2O"
        .Table.Cell(11, 2).Shape.TextFrame.TextRange.Text = "C2H5OH+3O2→2CO2+3H2O"
        .Left = 24
        .Top = 10
    End With
    For i = 1 To 10
    With Sld1.Shapes.AddLabel(msoTextOrientationHorizontal, 878, 46.5 * i - 6, 44, 44)
        .TextFrame.AutoSize = ppAutoSizeNone
        .TextFrame.TextRange.Text = i
        .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
        .TextFrame.VerticalAnchor = msoAnchorMiddle
        .Fill.ForeColor.RGB = rgbGreen
        .Name = "変更ボタン " & i
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "問題変更"
    End With
    Next
    With Sld1.Shapes.AddLabel(msoTextOrientationHorizontal, 878, 0, 44, 44)
        .TextFrame.AutoSize = ppAutoSizeNone
        .TextFrame.TextRange.Text = "編集"
        .TextFrame.TextRange.Font.Color.RGB = rgbBlack
        .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
        .TextFrame.VerticalAnchor = msoAnchorMiddle
        .Fill.ForeColor.RGB = rgbYellow
        .Name = "問題編集"
        .ActionSettings(ppMouseClick).Action = ppActionRunMacro
        .ActionSettings(ppMouseClick).Run = "問題編集"
    End With
    
    Dim Reg As New RegExp, Matches As MatchCollection
    With Reg
        .Global = True
        .Pattern = "[A-Za-z][0-9]+"
    End With
    Dim j
    For j = 2 To 11
        Set Matches = Reg.Execute(問題テーブル.Cell(j, 2).Shape.TextFrame.TextRange.Text)
        For i = 0 To Matches.Count - 1
            問題テーブル.Cell(j, 2).Shape.TextFrame.TextRange.Characters(Matches(i).FirstIndex + 2, Matches(i).Length - 1).Font.Subscript = True
        Next
    Next
    
End Sub
Sub 問題変更(TShp As Shape)
    
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    Dim Val(1 To 11, 1 To 6) As String
    
    Dim 化学反応式 As String, n As Long
    n = CLng(Split(TShp.Name)(1)) + 1
    
    化学反応式 = Sld1.Shapes("問題テーブル").Table.Cell(n, 2).Shape.TextFrame.TextRange.Text
    
    Dim Reg As New RegExp
    Dim 係数Matches As MatchCollection, 化合物Matches As MatchCollection   ', 係数抜きMatches As MatchCollection
    With Reg
        .Global = True
        .Pattern = "[\+→]([0-9]*)"
        Set 係数Matches = .Execute("+" & 化学反応式)
        .Pattern = "([0-9]*)([A-Z][a-z]?[A-Za-z0-9]*)"
        Set 化合物Matches = .Execute(化学反応式)
    End With
    
    Call 表作成
    
    Dim 矢印 As String, i As Long, j As Long, 係数 As String
    For i = 0 To 化合物Matches.Count - 1
        Val(1, i + 2) = 化合物Matches(i)
        
        係数 = 化合物Matches(i).SubMatches(0)
        If 係数 = "" Then 係数 = 1
        Val(2, i + 2) = Switch(係数 = "", 1, 係数 <> "", CLng(係数))
        
        Val(3, i + 2) = 式量(化合物Matches(i).SubMatches(1))
        
    Next
    
    For i = 1 To 11
        For j = 2 To 6
            If Val(1, j) = "" Then Sld2.Shapes(i & " " & j).Visible = msoFalse Else Sld2.Shapes(i & " " & j).Visible = msoTrue
        Next
    Next
    
    For i = 1 To 係数Matches.Count - 1 '1スタートは最初無視するため
        矢印 = 矢印 & Left(係数Matches(i), 1)
    Next
    Call 矢印作成(矢印)
    
    Dim k, Matches As MatchCollection
    For j = 2 To 6
        For i = 1 To 3
            Sld2.Shapes(i & " " & j).TextFrame.TextRange.Text = Val(i, j)
        Next
        With Reg
            .Pattern = "[A-Za-z][0-9]+"
            Set Matches = .Execute(Val(1, j))
        End With
        For k = 0 To Matches.Count - 1
            Sld2.Shapes(1 & " " & j).TextFrame.TextRange.Characters(Matches(k).FirstIndex + 2, Matches(k).Length - 1).Font.Subscript = True
        Next
    Next

End Sub

Sub 問題編集()
    Dim i
    i = InputBox("何番の問題を編集しますか? [1-10]")
    If IsNumeric(i) = False Then
        MsgBox ("番号が入力されなかったため，終了します。")
        Exit Sub
    Else
        i = CLng(i)
    End If
    
    Dim str, TRng As TextRange
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Set TRng = Sld1.Shapes("問題テーブル").Table.Cell(i + 1, 2).Shape.TextFrame.TextRange
    str = InputBox("問題を入力してください。+は半角，→は全角の矢印で。", , TRng.Text)
    If str <> "" Then TRng.Text = str
        
    Dim Reg As New RegExp
    With Reg
        .Global = True
        .Pattern = "[A-Za-z][0-9]+"
        Set Matches = .Execute(str)
    End With

    For i = 0 To Matches.Count - 1
        TRng.Characters(Matches(i).FirstIndex + 2, Matches(i).Length - 1).Font.Subscript = True
    Next
    

End Sub
Sub 表作成()
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    Dim Val(1 To 11, 1 To 6) As String
    Dim タイトル, 色, 文字色
    タイトル = Array("", "係数", "分子量・式量", "物質量の計算", "物質量(mol)", "個数の計算", "個数(個)", "質量の計算", "質量(g)", "気体の体積計算", "気体の体積(L)")
    色 = Array(rgbBlack, rgbLavender, rgbKhaki, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite)
    文字色 = Array(rgbWhite, rgbBlack, rgbDarkGreen, rgbBlack, rgbRed, rgbBlack, rgbBlack, rgbBlack, rgbBlack, rgbBlack, rgbBlack)
    
    Sld2.Shapes.Range.Delete
    Sld2.Layout = ppLayoutBlank
    
    Dim i, j
    
    For i = 0 To 行数 - 1
        For j = 0 To 列数 - 1
            With Sld2.Shapes.AddLabel(msoTextOrientationHorizontal, j * 列幅, i * 行高さ, 列幅, 行高さ)
                .Name = i + 1 & " " & j + 1
                
                With .TextFrame
                    .AutoSize = ppAutoSizeNone
                    .WordWrap = msoTrue
                    .TextRange.Font.Color.RGB = 文字色(i)
                    If j = 0 Then .TextRange.Text = タイトル(i)
                End With
                
                .Fill.ForeColor.RGB = 色(i) 'Switch(j = 0, rgbGreen, j <> 0, 色(i))
                If i = 4 Or i = 6 Or i = 8 Or i = 10 Then
                    With .ActionSettings(ppMouseClick)
                        .Action = ppActionRunMacro
                        .Run = "編集"
                    End With
                End If
            End With
        Next
    Next
    
    With Sld2.Shapes.AddLabel(msoTextOrientationHorizontal, 0, 0, 列幅 / 2, 行高さ)
        .TextFrame.AutoSize = ppAutoSizeNone
        .TextFrame.TextRange.Text = "表示"
        .Fill.ForeColor.RGB = rgbRed
        With .ActionSettings(ppMouseClick)
            .Action = ppActionRunMacro
            .Run = "表示"
        End With
    End With
    
    With Sld2.Shapes.AddLabel(msoTextOrientationHorizontal, 列幅 / 2, 0, 列幅 / 2, 行高さ)
        .TextFrame.AutoSize = ppAutoSizeNone
        .TextFrame.TextRange.Text = "変更"
        .Fill.ForeColor.RGB = rgbRed
        With .ActionSettings(ppMouseClick)
            .Action = ppActionFirstSlide
        End With
    End With

    
    With Sld2.Shapes.Range
        .Line.Weight = 1.5
        .Line.ForeColor.RGB = rgbBlack
        With .TextFrame
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
            .MarginLeft = 2
            .MarginRight = 2
            With .TextRange.Font
                .Name = "Meiryo UI"
                .Bold = msoTrue
                .Size = 24
            End With
        End With
    End With
    'Fontサイズ微調整
    For j = 2 To 6
        Sld2.Shapes(6 & " " & j).TextFrame.TextRange.Font.Size = 18
    Next
    Sld2.Shapes("10 1").TextFrame.TextRange.Font.Size = 20
    Sld2.Shapes("11 1").TextFrame.TextRange.Font.Size = 20
    'ここまで
    SlideShowWindows(Index:=1).View.GotoSlide Index:=2
    
End Sub

Sub 編集(TShp As Shape)
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    'Dim TShp As Shape: Set TShp = Sld2.Shapes("7 2") 'デバッグ用
    Dim TargetI, TargetJ, ret
    TargetI = Split(TShp.Name)(0)
    TargetJ = Split(TShp.Name)(1)
    ret = InputBox("値を入力 個数は 数値E指数 の形で")
    If IsNumeric(ret) = False Then Exit Sub
    
    Dim Val(1 To 11, 1 To 6) As Variant, i As Long, j As Long, tmp As Variant
    Val(TargetI, TargetJ) = CSng(ret)
    For i = 2 To 3
        For j = 2 To 6
            tmp = Sld2.Shapes(i & " " & j).TextFrame.TextRange.Text
            If tmp <> "" Then Val(i, j) = CSng(tmp)
        Next
    Next
    
    Sld2.Shapes("1 1").TextFrame.TextRange.Text = TargetI & " " & TargetJ
    
    Select Case TargetI
        Case Is = 5
            Val(1, TargetJ) = CSng(ret)
        Case Is = 7
            Val(1, TargetJ) = CSng(ret) / NA
        Case Is = 9
            Val(1, TargetJ) = CSng(ret) / CSng(Val(3, TargetJ))
        Case Is = 11
            Val(1, TargetJ) = CSng(ret) / 22.4
    End Select
    
    For j = 2 To 6
        If Val(2, j) <> "" Then
            Val(1, j) = Val(1, TargetJ) / Val(2, TargetJ) * Val(2, j)
            Val(5, j) = 有効数字表示(Val(1, j), 2, False)
            Val(4, j) = 有効数字表示(Val(5, TargetJ), 2, False) & "÷" & Val(2, TargetJ) & "×" & Val(2, j)
        End If
    Next
    
    For j = 2 To 6
        If Val(2, j) <> "" Then
            Val(6, j) = "6.0×1023×" & Val(5, j)
            Val(7, j) = 有効数字表示(NA * CSng(Val(1, j)), 2, True)
            Val(8, j) = Val(3, j) & "×" & Val(5, j)
            Val(9, j) = 有効数字表示(Val(3, j) * CSng(Val(1, j)), 2, False)
            Val(10, j) = "22.4×" & Val(5, j)
            Val(11, j) = 有効数字表示(22.4 * CSng(Val(1, j)), 3, False)
        End If
    Next
    
    Call 消去
    Dim 色 As Variant, 開始 As Long, 長さ As Long
    色 = Array(rgbBlack, rgbLavender, rgbKhaki, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite)
    For i = 4 To 11
        For j = 2 To 6
            If Val(i, j) <> "" Then
                With Sld2.Shapes(i & " " & j).TextFrame
                    .TextRange = Val(i, j)
                    .TextRange.Font.Color.RGB = 色(i - 1)
                    If i = 7 Then
                        tmp = Val(7, j)
                        開始 = InStr(tmp, "^")
                        長さ = Len(tmp) - 開始
                        .TextRange.Font.Superscript = msoFalse
                        .TextRange.Text = Replace(tmp, "^", "")
                        .TextRange.Characters(開始, 長さ).Font.Superscript = msoTrue
                    End If
                End With
            End If
        Next
    Next
    
    Sld2.Shapes(TargetI & " " & TargetJ).TextFrame.TextRange.Font.Color.RGB = rgbRed
End Sub
Sub 表示()
    Dim TargetI As Long, TargetJ As Long, i As Long, j As Long, k As Long, tmp As String
    Dim Val(1 To 11, 2 To 6) As Variant

    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    tmp = Sld2.Shapes("1 1").TextFrame.TextRange.Text
    TargetI = Split(tmp)(0)
    TargetJ = Split(tmp)(1)
    
    For i = 2 To 11
        For j = 2 To 6
            Val(i, j) = Sld2.Shapes(i & " " & j).TextFrame.TextRange.Text
            If i = 7 Then
                For k = 1 To Len(Val(7, j))
                    If Sld2.Shapes("7 " & j).TextFrame.TextRange.Characters(k).Font.Superscript = msoTrue Then
                        Val(7, j) = Left(Val(7, j), k - 1) & "^" & Mid(Val(7, j), k)
                        Exit For
                    End If
                Next
            End If
        Next
    Next
    
    Dim 物質量元文字数 As Long, 物質量文字数 As Long, 係数元文字数 As Long, 係数文字数 As Long, 開始 As Long, 長さ As Long
    物質量元文字数 = Len(Val(5, TargetJ))
    係数元文字数 = Len(Val(2, TargetJ))
    For i = 1 To 11
        For j = 2 To 6
            With Sld2.Shapes(i & " " & j)
                If Val(2, j) <> "" Then
                    If i = TargetI And j = TargetJ Then
                        .Fill.ForeColor.RGB = rgbYellow
                        .TextFrame2.TextRange.Font.Highlight = rgbYellow
                    End If
                    物質量文字数 = Len(Val(5, j))
                    係数文字数 = Len(Val(2, j))
                    tmp = Val(i, j)
                    Select Case i
                        Case Is = 2
                            .TextFrame.TextRange.Font.Color.RGB = rgbBlack
                            If j = TargetJ Then .TextFrame2.TextRange.Font.Highlight = rgbLime
                        Case Is = 3
                            .TextFrame.TextRange.Font.Color.RGB = rgbDarkGreen
                        Case Is = 4
                            With .TextFrame.TextRange
                                .Font.Color.RGB = rgbBlack
                                .Characters(1, 物質量元文字数).Font.Color.RGB = rgbBlue
                            End With
                            .TextFrame2.TextRange.Characters(1, InStr(tmp, "÷") - 1).Font.Highlight = rgbYellow
                            .TextFrame2.TextRange.Characters(物質量元文字数 + 2, 係数元文字数).Font.Highlight = rgbLime
                        Case Is = 5
                            If j = TargetJ Then
                                .TextFrame.TextRange.Font.Color.RGB = rgbBlack
                                .Fill.ForeColor.RGB = rgbYellow
                                .TextFrame2.TextRange.Font.Highlight = rgbYellow
                            End If
                            With .TextFrame.TextRange
                                .Font.Color.RGB = rgbRed
                                If j = TargetJ Then .Font.Color.RGB = rgbBlue
                            End With
                        Case Is = 6
                            With .TextFrame.TextRange
                                .Font.Color.RGB = rgbBlack
                                .Characters(7, 2).Font.Superscript = msoTrue
                                .Characters(10, 物質量文字数).Font.Color.RGB = Switch(j <> TargetJ, rgbRed, j = TargetJ, rgbBlue)
                            End With
                        Case Is = 7
                            With .TextFrame.TextRange
                                .Font.Color.RGB = rgbBlack
                                tmp = Val(7, j)
                                開始 = InStr(tmp, "^")
                                長さ = Len(tmp) - 開始
                                .Font.Superscript = msoFalse
                                .Text = Replace(tmp, "^", "")
                                .Characters(開始, 長さ).Font.Superscript = msoTrue
                            End With
                        Case Is = 8, 10
                            With .TextFrame.TextRange
                                .Font.Color.RGB = rgbBlack
                                If i = 8 Then .Characters(1, Len(Val(3, j))).Font.Color.RGB = rgbGreen
                                開始 = InStr(tmp, "×")
                                長さ = Len(tmp) - 開始
                                .Characters(開始 + 1, 長さ).Font.Color.RGB = Switch(j <> TargetJ, rgbRed, j = TargetJ, rgbBlue)
                            End With
                        Case Is = 9, 11
                            .TextFrame.TextRange.Font.Color.RGB = rgbBlack
                    End Select
                End If
            End With
        Next j
    Next i
    Sld2.Shapes(TargetI & " " & TargetJ).TextFrame.TextRange.Font.Color.RGB = rgbRed

    
End Sub
Sub 矢印作成(Val As String)
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)

    Dim i
    For i = 1 To Len(Val)
        If Mid(Val, i, 1) = "+" Then
            With Sld2.Shapes.AddShape(msoShapeCross, 列幅 * (i + 1) - 12.5, 15, 25, 25)
                .Adjustments(1) = 0.4
                .Fill.ForeColor.RGB = rgbWhite
            End With
        Else
            With Sld2.Shapes.AddShape(msoShapeRightArrow, 列幅 * (i + 1) - 12.5, 17.5, 25, 20)
                .Adjustments(1) = 0.3
                .Adjustments(2) = 0.4
                .Fill.ForeColor.RGB = rgbWhite
            End With
        End If
    Next
End Sub

Sub 消去()
    Dim Sld2 As Slide: Set Sld2 = ActivePresentation.Slides(2)
    Dim タイトル, 色, 文字色
    タイトル = Array("", "係数", "分子量・式量", "物質量の計算", "物質量(mol)", "個数の計算", "個数(個)", "質量の計算", "質量(g)", "気体の体積計算", "気体の体積(L)")
    色 = Array(rgbBlack, rgbLavender, rgbKhaki, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite, rgbLightSteelBlue, rgbWhite)
    文字色 = Array(rgbWhite, rgbBlack, rgbDarkGreen, rgbBlack, rgbRed, rgbBlack, rgbBlack, rgbBlack, rgbBlack, rgbBlack, rgbBlack)
    
    Dim i, j
    For i = 2 To 11
        For j = 2 To 6
            With Sld2.Shapes(i & " " & j)
                .Fill.ForeColor.RGB = 色(i - 1)
                .TextFrame2.TextRange.Font.Highlight = .Fill.ForeColor.RGB
                With .TextFrame.TextRange
                    If i > 3 Then .Text = ""
                    With .Font
                        .Color.RGB = 文字色(i - 1)
                        .Superscript = msoFalse
                    End With
                End With
            End With
        Next
    Next
End Sub

Function 式量(化学式 As String) As Single

    Dim arr原子量 As Variant
    arr原子量 = Split(原子量, ",")
    
    Dim Reg As New RegExp, Matches As MatchCollection
    With Reg
        .Global = True
        .Pattern = "([A-Z][a-z]?)([0-9]*)"
        Set Matches = .Execute(化学式)
    End With
    
    Dim i, j, 原子量_ As Single, 原子 As String, tmp As String, 添え字 As Long
    For i = 0 To Matches.Count - 1
        
        原子 = Matches(i).SubMatches(0)
        For j = 0 To UBound(arr原子量) - 2 Step 2
            If 原子 = arr原子量(j) Then 原子量_ = CSng(arr原子量(j + 1))
        Next
        
        tmp = Matches(i).SubMatches(1)
        If tmp = "" Then 添え字 = 1 Else 添え字 = CLng(tmp)
        式量 = 式量 + 原子量_ * 添え字
    Next

End Function

Function 個数(ByVal 物質量 As Single) As Single
    個数 = 物質量 * NA
End Function
Function 質量(ByVal 物質量 As Single, モル質量 As Long) As Single
    質量 = 物質量 * モル質量
End Function
Function 体積(ByVal 物質量 As Single) As Single
    体積 = 物質量 * 22.4
End Function

Function 物質量_個数(ByVal 個数 As Single) As Single
    物質量_個数 = 個数 / NA
End Function

Function 物質量_質量(ByVal 質量 As Single, モル質量 As Long) As Single
    物質量_質量 = 質量 / モル質量
End Function

Function 物質量_体積(ByVal 体積 As Single) As Single
    物質量_個数 = 体積 / 22.4
End Function

Function 有効数字表示(値 As Variant, 桁 As Long, 指数表示 As Boolean) As String
    Dim Val_ As String, Format_ As String
    If 桁 = 1 Then Format_ = "0" Else Format_ = "0." & String(桁 - 1, "0") & "e-0"
    Val_ = Format(CSng(値), Format_)
    
    If 指数表示 = True Then
        有効数字表示 = Replace(Val_, "e", "×10^")
    Else
        有効数字表示 = CSng(Left(Val_, InStr(Val_, "e") - 1) & "e" & Mid(Val_, InStr(Val_, "e") + 1))
        
        If InStr(有効数字表示, "E") = 0 Then
            Dim 数値スタート As Long, i As Long, 数値桁 As Long
            For i = 1 To Len(有効数字表示)
                If Mid(有効数字表示, i, 1) <> "0" And Mid(有効数字表示, i, 1) <> "." Then
                    数値スタート = i
                    Exit For
                End If
                
            Next
            
            数値桁 = Len(有効数字表示) - 数値スタート + 1
            If 桁 > 数値桁 Then
                If Len(有効数字表示) = 1 Then 有効数字表示 = 有効数字表示 & "."
                有効数字表示 = 有効数字表示 & String(桁 - 数値桁, "0")
            End If
        End If
    End If
End Function