Dim Hata3 As Boolean
Dim Retsu As Long
Dim MeNamae As Object
Dim Namae As String
Dim ListIndex As Long
Dim meSheet As Object
Dim vSheet As Object
Dim myno As Integer
Dim Rtn As Boolean
Dim SearchRow As Long
Dim ListIX As Long
Dim Idx As Long
Dim Bname3 As String
Dim HontSize As Integer
Private Sub UserForm_Initialize()
Set MeNamae = KensakuForm3
Set meSheet = Worksheets(1)
Set vSheet = Worksheets(2)
Maxl = meSheet.UsedRange.Rows.Count
Uform3 = ActiveSheet.Name
Bname3 = Uform3
HontSize = 9
Hata3 = Flag3
KensakuForm3.Caption = Bname3
If Flag3 = True Then
Replay
End If
End Sub
Private Sub CommandButton3_Click()
Dim Gword As String
Gword = Replace(Replace(ActiveCell.Text, " ", "+"), " ", "+")
CreateObject("WScript.Shell").Run "www.google.co.jp/search?q=" & Gword
End Sub
Private Sub CommandButton7_Click()
HontSize = HontSize + 1
KensakuForm3.ListBox1.Font.Size = HontSize
End Sub
Private Sub CommandButton8_Click()
HontSize = HontSize - 1
KensakuForm3.ListBox1.Font.Size = HontSize
End Sub
Private Sub CommandButton6_Click()
'これは選択したセルに入力されている住所をグーグルマップで表示するマクロです。grantish
Dim Smap As String
Dim Asearch As Integer
Dim WSH As Object
Set WSH = CreateObject("wscript.shell")
Smap = ActiveCell.Value
'Asearch = MsgBox("google mapで「" & Smap & "」を検索しますか?", vbYesNo)
'If Asearch = vbYes Then
WSH.Run "https://www.google.com/maps/place/" & Smap, 3
Set WSH = Nothing
'End If
End Sub
Private Sub Replay()
Unload UserForm3
KensakuForm3.Show vbModeless
TextBox1.Text = vNamae3
Raberu = vRaberu3
Label2.Caption = Raberu
Rtn = vRtn3
If Rtn Then
CheckBox1.Value = True
Else
CheckBox1.Value = False
End If
ListIX = vListIX3
myno = 3
Call 検索(ByVal Namae, MeNamae, Retsu, meSheet, Rtn, myno, vSheet)
ListBox1.ListIndex = ListIX
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Application.EnableEvents = False
If Button = 2 Then
Application.SendKeys "^v"
End If
Application.EnableEvents = True
End Sub
Private Sub CommandButton1_Click()
'Unload UserForm3
Namae = TextBox1.Value
Namae = StrConv(Namae, vbWide)
NamaeX3 = Namae
Retsu = Selec3
If CheckBox1.Value = True Then
Rtn = True
Else
Rtn = False
End If
vRtn3 = Rtn
If Retsu = 0 Then
MsgBox "ワークシートをクリックして検索されたい列を選択してください"
Else
End If
If Namae = "" Then
MsgBox ("検索キーワードを入力してください")
End If
If Retsu > 0 And Namae <> "" Then
myno = 3
Call 検索(ByVal Namae, MeNamae, Retsu, meSheet, vSheet, Rtn, myno)
Flag3 = True
If Flag3 Then
vListIX = ListIX
End If
End If
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
For i = 0 To MaxRows
Worksheets(2).Range("B1").EntireRow.Delete
Next
Unload KensakuForm3
Flag3 = False
UserForm3.Show vbModeless
End Sub
Private Sub ListBox1_Click()
Idx = ListBox1.ListIndex + 1
SearchRow = Worksheets(2).Cells(Idx, 2)
Worksheets(1).Cells(SearchRow, Retsu).Activate
ListIX = ListBox1.ListIndex
'vSheet.Cells(1, 6) = ListIX
End Sub
検索フォーム側の全コード