ConvertCurrency

' ConvertCurrency
' -----------------
' Macro Name: ConvertCurrency
' Description: 通貨換算を行う
' Parameters: なし
' Returns: なし
' Usage: 実行すると金額と通貨の種類を選択して変換結果をクリップボードにコピー
' -----------------

Sub ConvertCurrency()
    Dim currencyType As String
    Dim inputAmount As Double
    Dim resultAmount As Double
    Dim fromCurrency As String
    Dim toCurrency As String
    Dim ws As Worksheet
    Dim outputCell As String

    On Error GoTo ErrorHandler

    currencyType = InputBox("通貨ペアを選択:" & vbCrLf & _
                "1: USD -> JPY" & vbCrLf & _
                "2: JPY -> USD" & vbCrLf & _
                "3: EUR -> JPY" & vbCrLf & _
                "4: JPY -> EUR" & vbCrLf & _
                "5: GBP -> JPY" & vbCrLf & _
                "6: JPY -> GBP", "通貨換算", "1")

    If currencyType = "" Then
        Exit Sub
    End If

    inputAmount = InputBox("金額を入力:", "通貨換算")

    If inputAmount = "" Then
        Exit Sub
    End If

    If Not IsNumeric(inputAmount) Then
        MsgBox "数値を入力してください。", vbExclamation
        Exit Sub
    End If

    inputAmount = CDbl(inputAmount)

    Dim rate As Double

    Select Case currencyType
        Case "1"
            rate = 150
            fromCurrency = "USD"
            toCurrency = "JPY"
        Case "2"
            rate = 1 / 150
            fromCurrency = "JPY"
            toCurrency = "USD"
        Case "3"
            rate = 163
            fromCurrency = "EUR"
            toCurrency = "JPY"
        Case "4"
            rate = 1 / 163
            fromCurrency = "JPY"
            toCurrency = "EUR"
        Case "5"
            rate = 190
            fromCurrency = "GBP"
            toCurrency = "JPY"
        Case "6"
            rate = 1 / 190
            fromCurrency = "JPY"
            toCurrency = "GBP"
        Case Else
            MsgBox "無効な選択です。", vbExclamation
            Exit Sub
    End Select

    resultAmount = inputAmount * rate

    Set ws = ActiveSheet
    outputCell = InputBox("結果を出力するセルアドレスを入力:", "通貨換算", "A1")

    If outputCell <> "" Then
        ws.Range(outputCell).Value = resultAmount
        ws.Range(outputCell).NumberFormat = "#,##0.00"
    End If

    MsgBox inputAmount & " " & fromCurrency & " = " & Format(resultAmount, "#,##0.00") & " " & toCurrency, vbInformation

    Dim clip As Object
    Set clip = CreateObject("htmlfile").parentWindow.clipboardData
    clip.SetData "text", Format(resultAmount, "#,##0.00") & " " & toCurrency
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub