人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

http://q.hatena.ne.jp/1240142055の質問で
No.5の回答でVBSでやる方法を教えていただきましたが、
エクセルでマクロボタンを押して
実施できるように変更をしたいです。

どうぞよろしくお願いいたします。

●質問者: ohtsu6
●カテゴリ:コンピュータ
✍キーワード:VBS エクセル ボタン マクロ 実施
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● きゃづみぃ
●100ポイント

表示、ツールバー、コントロールツールボックスで ボタンを選択して

画面に貼り付けます。

貼り付けたボタンをダブルクリックして そこに ソースを記述すればいいですよ。


http://www.excel.studio-kazu.jp/lib/e1Ow/e1Ow.html

リストボックスの例

なお エクセルのバージョンによって 出し方が違います。


2 ● きゃづみぃ
●0ポイント

記述の仕方ですが 以下のようにします。

Private Sub CommandButton1_Click()
Dim RetVal
 RetVal = Shell("wscript.exe ""VBSのフルパス""", 1)
End Sub
◎質問者からの返答

takntさま

ありがとうございます。

とても参考になりました。


3 ● Mook
●500ポイント ベストアンサー

基本的には単純な置き換えで VBS は VBA で動作できるように変更できます。


今回やったのは下記の内容です。

・最初の部分を Sub で囲む。

・WScript.... を代替関数に置き換える。

( WScript.Echo は MsgBox でよいと思います。)


今回のコードだとこんな感じになると思いますが、どうでしょうか。

シートにボタンを配置し InsertTags を割り当ててください。

Option Explicit

'---------------------------------------------------------------------
Const INSERT_FILE = "C:\Data\insert.txt" '--- 挿入するファイル名の指定
Const HTML_FOLDER = "C:\HTMLFiles"  '--- 変換対象ファイルのフォルダを指定
Const KEY_WORD = "</div>"  '--- 検索するタグの指定
Const KEY_COUNT = 13  '--- 検索後の置換して位置
'---------------------------------------------------------------------

Sub InsertTags()
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 If fso.FileExists(INSERT_FILE) = False Then
 MsgBox "挿入データファイル【" & INSERT_FILE & "】がありません: "
 Exit Sub
 End If
 Dim insData
 insData = fso.OpenTextFile(INSERT_FILE).ReadAll()
 
 Dim fCount
 Dim hFile
 Dim txtData
 Dim pos
  '--- 指定フォルダ内の HTML ファイルを処理
 For Each hFile In fso.GetFolder(HTML_FOLDER).Files
  '--- 拡張子のチェック ---
 If UCase(fso.GetExtensionName(hFile)) = "HTML" Then
 txtData = fso.OpenTextFile(hFile.Path).ReadAll()
 pos = getPos(txtData)
 If pos > 0 Then
 If Mid(txtData, pos + 1, 1) = Chr(10) Or Mid(txtData, pos + 1, 1) = Chr(13) Then
 txtData = Left(txtData, pos) & vbNewLine & insData & Mid(txtData, pos + 1)
 Else
 txtData = Left(txtData, pos) & vbNewLine & insData & vbNewLine & Mid(txtData, pos + 1)
 End If
  '--- ファイルをバックアップして更新 ---
 fso.CopyFile hFile.Path, hFile.Path & ".bak"  '--- バックアップが不要な場合はこの行を削除
 fso.CreateTextFile(hFile.Path, True).Write txtData
 fCount = fCount + 1
 Else
  '--- タグが指定回数ない
 MsgBox hFile.Name & ":指定回数の " & KEY_WORD & " がありません。"
 End If
 End If
 Next
 MsgBox fCount & " 個のファイルを処理しました。"
End Sub
 
'---------------------------------------------------------------------
' 挿入位置の検索
'---------------------------------------------------------------------
Function getPos(txtData)
'---------------------------------------------------------------------
 Dim sPos
 Dim dCount
 sPos = InStr(txtData, KEY_WORD)
 Do While sPos > 0
 dCount = dCount + 1
 If dCount = KEY_COUNT Then
 getPos = sPos + Len(KEY_WORD) - 1
 Exit Function
 End If
 sPos = InStr(sPos + 1, txtData, KEY_WORD)
 Loop
End Function



Const INSERT_FILE = "C:\Data\insert.txt"
Const HTML_FOLDER = "C:\HTMLFiles" 

の部分は下記のように書き換えると、セルでファイルやフォルダを指定することができるようにもできます。


Sub InsertTags()
 Dim INSERT_FILE
 INSERT_FILE = Range("A1").Value

 Dim HTML_FOLDER
 HTML_FOLDER = Range("A2").Value

 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 :
 :
 :



挿入する内容をセルで記載する場合は下記のように修正してください。

 Dim insData
 insData = Range("A1").Value
◎質問者からの返答

Mookさま

望みどおりのものができました。

ありがとうございます。

ちなみにですが、

上記でA1にファイルのパスを記入するやり方を

教えていただきましたが、

実際にA1の内容を挿入することはできますでしょうか?

どうぞよろしくお願いいたします。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ