諸般の事情で昔作ったVisual Studio Basiuc版をVBAで作り直しました。簡易版です。
-----------------------
Sub ppiとpxからmmを求める()
Sub ppiとpxからmmを求める()
Dim ppi As Double
Dim px As Double
Dim mm As Double
Dim ppi_Input As String
Dim px_Input As String
' ppiの入力を促す
ppi_Input = InputBox _
("ppiを入力してください(例: 220)", "ppi入力")
' ユーザーがキャンセルを押した場合、処理を終了
If ppi_Input = "" Then Exit Sub
' ピクセル数の入力を促す
px_Input = InputBox _
("ピクセル数を入力してください(例: 1920)", "ピクセル入力")
' ユーザーがキャンセルを押した場合、処理を終了
If px_Input = "" Then Exit Sub
' 入力値を数値に変換
ppi = Val(ppi_Input)
px = Val(px_Input)
' ppiとピクセル数が正しいかチェック
If ppi > 0 And px > 0 Then
mm = (px / ppi) * 25.4
' 結果を表示
MsgBox "計算結果: " & Format(mm, "0.00") & " mm", _
vbInformation, "計算結果"
Else
' 入力値が無効な場合のエラーメッセージ
MsgBox "ppiとピクセル数を正しく入力してください。", _
vbExclamation, "入力エラー"
End If
End Sub
Sub pxとmmからppiを求める()
Dim px As Double
Dim mm As Double
Dim ppi As Double
Dim px_Input As String
Dim mm_Input As String
' ピクセル数の入力を促す
px_Input = InputBox _
("ピクセル数を入力してください(例: 1920)", "ピクセル入力")
' ユーザーがキャンセルを押した場合、処理を終了
If px_Input = "" Then Exit Sub
' ミリメートルの入力を促す
mm_Input = InputBox _
("ミリメートルを入力してください(例: 210)", "ミリメートル入力")
' ユーザーがキャンセルを押した場合、処理を終了
If mm_Input = "" Then Exit Sub
' 入力値を数値に変換
px = Val(px_Input)
mm = Val(mm_Input)
' ピクセル数とmmが正しいかチェック
If px > 0 And mm > 0 Then
' ピクセル数とmmからppiを計算
ppi = (px / mm) * 25.4
' 結果を表示
MsgBox "計算結果: " & Format(ppi, "0.00") _
& " ppi", vbInformation, "ppi計算結果"
Else
' 入力値が無効な場合のエラーメッセージ
MsgBox "ピクセル数とミリメートルを正しく入力してください。", _
vbExclamation, "入力エラー"
End If
End Sub
Sub ppiとmmからpxを求める()
Dim ppi As Double
Dim mm As Double
Dim px As Double
Dim ppi_Input As String
Dim mm_Input As String
' ppiの入力を促す
ppi_Input = InputBox _
("ppiを入力してください(例: 220)", "ppi入力")
' ユーザーがキャンセルを押した場合、処理を終了
If ppi_Input = "" Then Exit Sub
' ミリメートルの入力を促す
mm_Input = InputBox _
("ミリメートルを入力してください(例: 210)", "ミリメートル入力")
' ユーザーがキャンセルを押した場合、処理を終了
If mm_Input = "" Then Exit Sub
' 入力値を数値に変換
ppi = Val(ppi_Input)
mm = Val(mm_Input)
' ppiとmmが正しいかチェック
If ppi > 0 And mm > 0 Then
' ppiとmmからピクセル数を計算
px = (ppi * mm) / 25.4
' 結果を表示
MsgBox "計算結果: " & Format(px, "0") _
& " ピクセル", vbInformation, "ピクセル計算結果"
Else
' 入力値が無効な場合のエラーメッセージ
MsgBox "ppiとミリメートルを正しく入力してください。", _
vbExclamation, "入力エラー"
End If
End Sub
-----------------------