Excel VBA質問箱 IV

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

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


24012 / 76732 ←次へ | 前へ→

【58075】Re:大文字変換
発言  ぴかる  - 08/10/1(水) 14:29 -

引用なし
パスワード
   sekoさん、こんにちは。

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


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

0 hits

【58072】大文字変換 seko 08/10/1(水) 14:04 発言
【58074】Re:大文字変換 kanabun 08/10/1(水) 14:24 発言
【58075】Re:大文字変換 ぴかる 08/10/1(水) 14:29 発言
【58076】Re:大文字変換 seko 08/10/1(水) 15:00 回答

24012 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free