セル内の文字で、テクノラティのタグを作成したい

質問

すみません、よろしくお願いします。

エクセルのセル内の文字から、
ブログに貼り付けるテクノラティのタグを作成したのですが、
関数などでできませんでしょうか。

２、３個でしたらタグクリエイターでできるのですが、
５０個とか、１００個一度にしたいのです。

よろしくお願いします。

回答No.3

xls88 · ベストアンサー

良い方法が見つからなかったので、Windows API関数とSendKeysを使いました。
Windows API関数は、Web検索で見つかったものを、そっくり使わせていただきました。
タグクリエイターのページが表示されている状態で、test1マクロを実行してください。
A列のデータを、タグ変換したテキストが、B列に書き込まれます。

Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long
Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long

Sub IE_SetFront()
Dim MyShell As Object, MyWindow As Object, objIE As Object
Dim hWnd As Long

Set MyShell = CreateObject("Shell.Application")
For Each MyWindow In MyShell.Windows
　　 If TypeName(MyWindow.document) = "HTMLDocument" Then
　　　　 Set objIE = MyWindow: Exit For
　　 End If
Next
If Not objIE Is Nothing Then
　　 hWnd = objIE.hWnd
　　 SetForegroundWindow hWnd
　　 If IsIconic(hWnd) Then OpenIcon hWnd
End If
Set objIE = Nothing: Set MyShell = Nothing
End Sub

Sub test1()
　　Dim objIE As Object
　　Dim myTitle As String
　　Dim myTag As String
　　Dim htmTag As String
　　Dim i As Long
　　Dim j As Long

　　myTitle = "タグクリエイター"
　　For Each objIE In CreateObject("Shell.Application").Windows
　　　　If objIE.document.Title = myTitle Then
　　　　　　For i = 1 To 10
　　　　　　　　myTag = ThisWorkbook.Sheets("Sheet1").Cells(i, "A").Value
　　　　　　　　With objIE.document
　　　　　　　　　　.getElementsByTagName("textarea")("result").Value = ""
　　　　　　　　　　.getElementsByTagName("Input")("Query").Value = ""
　　　　　　　　　　.getElementsByTagName("Input")("Query").Value = myTag
　　　　　　　　　　.getElementsByTagName("Input")("Query").Select

　　　　　　　　　　For j = 1 To 10
　　　　　　　　　　　　Call IE_SetFront
　　　　　　　　　　　　SendKeys "{F2}", True
　　　　　　　　　　Next j

　　　　　　　　　　AppActivate Application.Caption
　　　　　　　　　　htmTag = .getElementsByTagName("textarea")("result").Value
　　　　　　　　　　ThisWorkbook.Sheets("Sheet1").Cells(i, "B").Value = htmTag
　　　　　　　　End With
　　　　　　Next i
　　　　End If
　　　　If objIE.document.Title = myTitle Then Exit For
　　Next objIE
End Sub

回答No.6

xls88

＞回答番号：No.5 この回答への補足
試しに、IE6(タグクリエイターを表示)とExcelのみ起動、他のプログラムは閉じて、マクロを実行してみてください。
あるいは、パソコンを再起動し、IE6(タグクリエイターを表示)とExcelのみ起動してマクロを実行してみてください。

# 既出のコードを全文、再掲載するのは資源の無駄遣いだと思います。
エラー内容を補足していただいたのは良かったです。
欲を言えば、コードのエラー行も明示していただくと、もっと良かったと思います。

お礼

xls88さんへ

今回は、長期間にわたりお付き合いいただき、
ありがとうございました。
私のミスもあり、いろいろご迷惑をおかけしてすみませんでした。

希望の動作のマクロを使うことができ、大変ありがたかったです。
ありがとうございました。

補足

xls88さん、こんにちは。

再起動後、ご指摘の方法（IE6(タグクリエイターを表示)とExcelのみ起動）で動作しました。
また、Range("A1:A10")のA10の数を増やすことで
大量の変換ができそうです。

># 既出のコードを全文、再掲載するのは資源の無駄遣いだと思います。
はい、ただ、今回はエラーが出たので、実行した
マクロの内容が間違っているのかと思い、書かせていただきました。

>欲を言えば、コードのエラー行も明示していただくと、もっと良かったと思います。
そうですね。エラーの行が表示されてました。
書き忘れでした。

長い間いろいろお世話になりました。
これで先に進めます。

ありがとうございました。

回答No.5

xls88

＞回答番号：No.4 この回答への補足

回答番号：No.3のコードをすべてコピペして、test1マクロのみ、回答番号：No.4のtest3マクロに差し替えてください。

補足

xls88さん、ありがとうございます。

Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long
Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long

Sub IE_SetFront()
Dim MyShell As Object, MyWindow As Object, objIE As Object
Dim hWnd As Long

Set MyShell = CreateObject("Shell.Application")
For Each MyWindow In MyShell.Windows
If TypeName(MyWindow.Document) = "HTMLDocument" Then
Set objIE = MyWindow: Exit For
End If
Next
If Not objIE Is Nothing Then
hWnd = objIE.hWnd
SetForegroundWindow hWnd
If IsIconic(hWnd) Then OpenIcon hWnd
End If
Set objIE = Nothing: Set MyShell = Nothing
End Sub

Sub test3()
Dim objSA As Object
Dim rng As Range
Dim myTime As Variant
Dim myTitle As String
Dim myTag As String
Dim htmTag As String
Dim i As Long
Dim j As Long

myTitle = "タグクリエイター"
For Each objSA In CreateObject("Shell.Application").Windows
If objSA.Document.Title = myTitle Then
For Each rng In ActiveSheet.Range("A1:A10")
myTag = rng.Value
With objSA.Document
.getElementsByTagName("textarea")("result").Value = ""
.getElementsByTagName("Input")("Query").Value = ""
.getElementsByTagName("Input")("Query").Value = myTag
.getElementsByTagName("Input")("Query").Select
For j = 1 To 100
Call IE_SetFront
SendKeys "{F2}", True
htmTag = .getElementsByTagName("textarea")("result").Value
If htmTag <> "" Then Exit For
Next j
End With
rng.Offset(0, 1).Value = htmTag
Next rng
End If
If objSA.Document.Title = myTitle Then Exit For
Next objSA
End Sub

を貼り付けました。
それで、
IE6で、タグクリエイターを表示、
A1にtest、A2～10にも適当な文字列をいれ、
B1にカーソルを置いた状態で、test3マクロを実行しました。

IE6のタグクリエイターのキーワード入力画面に「test」は
入りましたが、

実行エラー'-2147467259 (80004005)';
'HWND'メソッドは失敗しました。'IWebBrowser2'オブジェクト

のエラーが出ます。
うーん、なかなかうまくいきません。すみません。

回答No.4

xls88

放置スレのようですが、回答番号：No.3のtest1マクロをまとめ直してみました。

Sub test3()
　　Dim objSA As Object
　　Dim rng As Range
　　Dim myTime As Variant
　　Dim myTitle As String
　　Dim myTag As String
　　Dim htmTag As String
　　Dim i As Long
　　Dim j As Long

　　myTitle = "タグクリエイター"
　　For Each objSA In CreateObject("Shell.Application").Windows
　　　　If objSA.Document.Title = myTitle Then
　　　　　　For Each rng In ActiveSheet.Range("A1:A10")
　　　　　　　　myTag = rng.Value
　　　　　　　　With objSA.Document
　　　　　　　　　　.getElementsByTagName("textarea")("result").Value = ""
　　　　　　　　　　.getElementsByTagName("Input")("Query").Value = ""
　　　　　　　　　　.getElementsByTagName("Input")("Query").Value = myTag
　　　　　　　　　　.getElementsByTagName("Input")("Query").Select
　　　　　　　　　　For j = 1 To 100
　　　　　　　　　　　　Call IE_SetFront
　　　　　　　　　　　　SendKeys "{F2}", True
　　　　　　　　　　　　htmTag = .getElementsByTagName("textarea")("result").Value
　　　　　　　　　　　　If htmTag <> "" Then Exit For
　　　　　　　　　　Next j
　　　　　　　　End With
　　　　　　　　rng.Offset(0, 1).Value = htmTag
　　　　　　Next rng
　　　　End If
　　　　If objSA.Document.Title = myTitle Then Exit For
　　Next objSA
End Sub

補足

xls88さん、こんにちは。
何回もありがとうございます。
正月は実家に帰ってて、ネットにつないでませんでした。m(__)m

さっそくですが、サンプルのSubからEnd Subまでを、
マクロに登録して、
エクセルのA1にtestといれて、
IE6でタグクリエイターを表示させて、
マクロを実行しました。
すると、コンパイルエラー「SubまたはFunctionが定義されていません」のエラーが出て、先に進めませんでした。
なにか手順が間違っているのでしょうか。
（このマクロでどういう動作になるのか
いまいちわかってなくて、すみません）

回答No.2

xls88

一部誤魔化しのサンプルマクロができました。
タグクリエイター
http://syndication.jp/tools/trjtagmk/generater.html​
を開いてからマクロを実行してください。

Sub test1()
　　Dim objIE As Object
　　Dim mytime As Variant
　　Dim myTitle As String
　　Dim myTag As String
　　Dim htmTag As String
　　Dim i As Long
　　Dim ret

　　myTag = ActiveSheet.Range("A2").Value
　　myTitle = "タグクリエイター"
　　For Each objIE In CreateObject("Shell.Application").Windows
　　　　With objIE.Document
　　　　　　If .Title = myTitle Then
　　　　　　　　.getElementsByTagName("textarea")("result").Value = ""
　　　　　　　　.getElementsByTagName("Input")("Query").Value = ""

　　　　　　　　.getElementsByTagName("Input")("Query").Value = myTag

　　　　　　　　'どう書けばよいか分からないのでとりあえず誤魔化し
　　　　　　　　.getElementsByTagName("Input")("Query").Select
　　　　　　　　ret = Application.InputBox("IEをクリックしてF2キー押す")

　　　　　　　　htmTag = .getElementsByTagName("textarea")("result").Value
　　　　　　　　ActiveSheet.Cells(2, "B").Value = htmTag
　　　　　　　　Exit For
　　　　　　End If
　　　　End With
　　Next objIE
End Sub

ゴルフ
で
%E3%82%B4%E3%83%AB%E3%83%95
と変換されたのですが、変換の法則を教えていただけないでしょうか。

補足

>と変換されたのですが、変換の法則を教えていただけないでしょうか。

セルに入力した文字を、UTF-8でURLエンコードしたいんです。

>%E3%82%B4%E3%83%AB%E3%83%95

は、これでＯＫだと思いますので、あとは、
エクセル内で処理できたらうれしいんですが。(^_^;)

回答No.1

xls88

セルデータをどのように加工すればよいのでしょうか？
過去ログですが、参考になるでしょうか？
マクロでhtml出力？
http://oshiete1.goo.ne.jp/qa4480277.html?ans_count_asc=20

補足

xls88さん、はじめまして。
ご回答ありがとうございます。

>マクロでhtml出力？

タグクリエイター
http://syndication.jp/tools/trjtagmk/generater.html

で出力されるＵＲＬの形式が欲しいです。
具体的には、A1に「タグクリエイター」と入力したら、
B2に、「<a href="http://technorati.jp/tag/%E3%82%BF%E3%82%B0%E3%82%AF%E3%83%AA%E3%82%A8%E3%82%A4%E3%82%BF%E3%83%BC" rel="tag">タグクリエイター</a>」と変換したいです。
これがA2～A100にも文字を入れたらB2～B100に
該当の文字に対するURLに変換しれくれる、という
動作を希望です。
なので、セルに直接「=～」で書き込めると
私のスキル的には一番ベストですが、それ以外の
実現方法でも（マクロなど）勉強して使えるように
したいと思います。

すみません、何かいい案ありましたらよろしくお願いします。