Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

24018 / 76738

←次へ　｜　前へ→


	【58075】Re:大文字変換

ぴかる - 08/10/1(水) 14:29 -


	引用なし

	パスワード

sekoさん、こんにちは。

私が５年程前にこのサイトにて紹介して頂いた「ピカつーる」の文字変換機能です。選択したセルすべてを変換します。お試し下さい。

Sub 使用セルを取得する()
　
　　Frg = 0
　　Set r1 = Selection
　　On Error Resume Next
　　Set r2 = r1.SpecialCells(xlCellTypeConstants)
　　On Error GoTo 0
　　
　　If (r2 Is Nothing) Or ((Selection.Count = 1) And (ActiveCell.Value = "")) Then
　　　　MsgBox "該当するセルが見つかりません。", vbExclamation
　　　　Frg = 1
　　ElseIf Selection.Count > 1 Then
　　　　r2.Select
　　End If
　　
　　Set r2 = Nothing

End Sub
Sub 全角()
　　　　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbWide)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing
　
End Sub
Sub 半角()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbNarrow)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing
　
End Sub
Sub 大文字()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbUpperCase)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing

End Sub
Sub 小文字()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbLowerCase)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing

End Sub
Sub 先頭大文字()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbProperCase)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing

End Sub
Sub カタカナ()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbKatakana)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing

End Sub
Sub ひらがな()
　　
　　Dim セル As Range
　　
　　使用セルを取得する
　　If Frg = 1 Then Exit Sub
　　Application.ScreenUpdating = False　 '画面固定
　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　For Each セル In Selection
　　　　セル = StrConv(セル, vbHiragana)
　　Next
　　
　　r1.Select
　　Set r1 = Nothing

End Sub

3 hits

▼

【58072】大文字変換 seko 08/10/1(水) 14:04