選択した文字列の位置と文字数を取得したい(VBA)

質問

セルや図形にテキストを入力し、
そのテキストの一部分を選択した状態でマクロを実行した時に、
何文字目から何文字目までを選択しているのかを取得するコードを
ご存知の方がおられましたら教えていただけませんでしょうか？

文字列の内容、選択する部分は決まっていません。
使用環境は、Windows7とMicrosoft Excel2010です。
よろしくお願いいたします。

回答No.3

eden3616

No1です。
他の方法で。。。。

ユーザーフォーム（UserForm1）を作成してテキストボックス（TextBox1）を作成してください。
標準モジュールを挿入してください。
以下の二つのコードを、ユーザーフォームと標準モジュールにそれぞれ貼り付けてください。

対象のセルまたはシェイプを選択した状態でマクロ「sample」を実行してください。
このときの「選択」とは文字列選択ではなく、セルやシェイプの選択（Select）です。

ユーザーフォームが表示され、テキストボックスに値が入っていますので
カーソルで文字選択を行いエンター（Enter）キーを押してください。
結果が広域変数「no(0)、no(1)」に格納されて結果がダイアログで表示されます。

■ユーザーフォーム（UserForm1）に以下のコードを記載

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'エンターが押されたら実行
If KeyCode = 13 Then
　　With Me.TextBox1
　　　　'開始文字番号を格納
　　　　no(0) = .SelStart + 1
　　　　'終了文字番号を格納
　　　　no(1) = .SelStart + .SelLength
　　End With
　　Unload Me
End If
End Sub

■標準モジュールに以下のコードを記載

'結果用の広域変数を用意
Public no(1) As Integer

Sub sample()
Dim word As String
Load UserForm1
'判定
If TypeName(Selection) = "Range" Then
　　'セルの場合
　　word = Selection.Value
Else
　　'オートシェイプの場合
　　word = ActiveSheet.Shapes(Selection.ShapeRange.Name).TextFrame.Characters.Text
End If
UserForm1.TextBox1.Value = word
'フォームを表示
UserForm1.Show
'結果表示
If no(0) = 0 Then Exit Sub
word = Mid(word, no(0), no(1) - no(0) + 1)
If Len(word) = 0 Then
　　MsgBox "文字範囲が選択されていません"
Else
　　MsgBox "文字範囲：" & no(0) & "～" & no(1) & vbCrLf & "「" & word & "」が選択されました"
End If
End Sub

回答No.2

misatoanna

ユーザーフォームを利用する方法はいかがでしょうか。

ユーザーフォームを作成し、テキストボックスとコマンドボタンを一つずつ配します。（下図）
↓
作成したコマンドボタンをダブルクリックして表示される画面に、以下を記述します。
-------
Private Sub CommandButton1_Click()
　Dim st, en
　st = TextBox1.SelStart + 1
　en = st + TextBox1.SelLength - 1
　MsgBox st & "文字目から" & en & "文字目まで、" _
　　　　　　& TextBox1.SelLength & "文字を選択中"
End Sub
↓
シートモジュールに以下を記述し、Visual Basic Editor を閉じます。
-------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　If Intersect(Target, Range("A1:A11")) Is Nothing Then Exit Sub
　With UserForm1
　　.TextBox1.Value = ActiveCell.Value
　　.Show 0
　End With
End Sub
-------
とりあえず A1:A10 内のセルをクリックしたときにユーザーフォームが表示されるようにしていますが、実情に合わせて指定範囲を書き替えてください。

範囲内のセルをクリックするとユーザーフォームが表示され、テキストボックスにセルの値が書き込まれていますので、任意の文字列を選択してからコマンドボタンをクリックします。

回答No.1

eden3616

セルの文字列で、一部を選択した状態ではマクロ（VBA）を実行することができませんので
お望みの動作をすることは難しいかと。

文字を入力
　　↓
特定の文字をCtrl+Vでコピー（クリップボードに格納）
　　↓
対象のセル or シェイプを選択
　　↓
VBAを実行
　　↓
セルの値や、シェイプの内容をクリップボードの内容で検索
一致した値のインデックスを取得・表示

苦肉の策ですが、上記流れで作成してみました。

(1)以下のコードを標準モジュールへ張り付け。
(2)対象の文字をコピー（Ctrl+V）　
　　（※セルコピーではなく、F2で編集可能にした後の文字列コピーです）
(3)対象のセルを選択又は、オートシェイプを選択。
(4)マクロ「sample」を実行。
(5)ダイアログで結果が表示されます。

添付画像の左側のダイアログは、上側のセルより「dw」を、
右側のダイアログはオートシェイプの「as」を検索した結果になります。
（読めるかな？）

■VBAコード

Sub sample()
Dim buf As String, ckWord As String
Dim msg As String, hit As Integer, cnt As Integer

'―――――クリップボードを取得―――――
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
　　.GetFromClipboard
　　buf = .GetText
End With

'―――――対象の文字を取得―――――
If TypeName(Selection) = "Range" Then
　　'セルの場合
　　ckWord = Selection.Value
Else
　　'オートシェイプの場合
　　ckWord = ActiveSheet.Shapes(Selection.ShapeRange.Name).TextFrame.Characters.Text
End If

'―――――検索処理―――――
Do
　　cnt = cnt + 1
　　'文字列を検索
　　cnt = InStr(cnt, ckWord, buf)
　　If cnt = 0 Then
　　　　'見つからなくなったら終了
　　　　Exit Do
　　Else
　　　　'見つかったら結果を取得
　　　　hit = hit + 1
　　　　'結果を改行
　　　　If msg <> "" Then msg = msg & vbCrLf
　　　　'結果を追加
　　　　msg = msg & hit & "番目：開始=" & cnt & "/終了=" & cnt + Len(buf) - 1
　　End If
Loop

'―――――結果を表示―――――
MsgBox msg
End Sub