セルの範囲を選択するのは、
Dim objHANI As Range '選択されたセルの集合
とオブジェクト変数を宣言してから、
Set objHANI = Application.InputBox(prompt:="セルを選択", Type:=8)
.InputBoxを使用して、セルを選択させる
ポイントはType:=8で文字列ではなくオブジェクトを返すことです。
Application.InputBox
で
Rangeを受け取る解説は、
No.11 InputBox関数で簡単な値を受け取る
http://www.ken3.org/backno/backno_vba03.html#11
を参照してください。
InputBox関数とApplication.InputBoxメソッドの違いが書いてあります。
選択されたか?をチェックしたいので、
If IsEmpty(objHANI) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
End If
と
IsEmpty関数を使用してチェックしてます。
選択された範囲に対して、
MsgBox objHANI.Rows.Count '行数
MsgBox objHANI.Columns.Count '列数
を取り出すことができます。
No.51 Excel Range オブジェクトを使う
http://www.ken3.org/backno/backno_vba11.html#51
で、
objHANI.Rows.Countの行カウントと、
~~~~~~~~~~~
objHANI.Columns.Count列カウントです。
~~~~~~~~~~~~~~
Rangeについて、軽く書いてます。
範囲が選択できたら、ファイルの書き込みかぁ、
パターン化になっているけど、
Freeファイルであいているファイル番号を取り出し、
Open
Write
Close
Print #FNO, "XXXXXXX";
とセミコロンを付けると改行されないのもポイントです。
テキストファイル関係は、
^^^^^^^^^^^^^^^^^^^^^^^^
No.27 テキストファイル処理 ファイルへの書き込み
http://www.ken3.org/backno/backno_vba06.html#27
Open
Close
Print #
No.29 テキストファイル処理 ファイルからの読み込み
http://www.ken3.org/backno/backno_vba06.html#29
Line Input #
Eof関数
No.31 Write #で ””を付けた書き込み
http://www.ken3.org/backno/backno_vba07.html#31
Write #
No.33 FreeFile関数で空いてるファイル番号を返す方法
http://www.ken3.org/backno/backno_vba07.html#33
FreeFile
で、簡単な解説を書いてます。
IEの起動は、
^^^^^^^^^^^^^^
Dim objIE As Object 'IEオブジェクト参照用
と、オブジェクト変数を定義して、
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
CreateObjectを使用して、IEのオブジェクトを作成。
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strFNAME '文字列で指定したURLに飛ぶ
と、メソッド(動作)を使用して、URLを開きます。
No.50 IE起動 CreateObject("InternetExplorer.application")
http://www.ken3.org/backno/backno_vba11.html#50
で、
IEのオブジェクト、起動方法を解説してます。
/*
* 3.固定処理で作成するか
*/
Sub test15_1()
'Application.InputBoxでセルを選択させる
Dim objHANI As Range '選択されたセルの集合
Set objHANI = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objHANI) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
Dim strFNAME As String 'ファイル名保存用
FNO = FreeFile '空いてるファイル番号を取出す
strFNAME = ThisWorkbook.Path & "\test.html" 'ファイル名を作る
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>"; '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'セルの値を<TD>で囲って出力
Print #FNO, "<TD>" & objHANI.Cells(y, x).Value & "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
'おまけでIEを起動して、表示
Dim objIE As Object 'IEオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strFNAME '文字列で指定したURLに飛ぶ
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.html" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_HTML_TABLE(strFNAME, objTARGET)
'できたファイルをIEで表示して確認する
Call IE_OPEN_URL(strFNAME) 'ファイル名を渡す
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub
'ファイル名とセルの範囲RANGEを受け取り、
'ファイルを開きHTMLのテーブルを作成する
Sub MAKE_HTML_TABLE(strFNAME As String, objHANI As Range)
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成してみました"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>"; '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'セルの値を<TD>で囲って出力
Print #FNO, "<TD>" & objHANI.Cells(y, x).Value & "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub
'URLを受け取り、IEを起動、URLを開く
Sub IE_OPEN_URL(strURL As String)
'IEを起動して、表示
Dim objIE As Object 'IEオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strURL '文字列で指定したURLに飛ぶ
End Sub
Sub MAKE_HTML_TABLE(strFNAME As String, objHANI As Range)
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成してみました"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>"; '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'セルの値を<TD>で囲って出力
Print #FNO, "<TD>" & objHANI.Cells(y, x).Value & "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub
HTMLファイルを作成しているサブルーチンで、
'セルの値を<TD>で囲って出力
Print #FNO, "<TD>" & objHANI.Cells(y, x).Value & "</TD>";
と、単純に<TD>で囲っている部分を、
<TD ALIGN='RIGHT'><TD ALIGN='LEFT'><TD ALIGN='CENTER'>
セルの位置によって変化させます。
'ALIGNを調べて書き込む
Select Case objHANI.Cells(y, x).HorizontalAlignment
Case xlRight:
Print #FNO, "<TD ALIGN='RIGHT'>"
Case xlLeft:
Print #FNO, "<TD ALIGN='LEFT'>"
Case xlCenter:
Print #FNO, "<TD ALIGN='CENTER'>"
Case Else 'その他設定無しのとき
Print #FNO, "<TD>"
End Select
力技で書くと、こんな感じです。
Sub Macro1()
Range("B2:C4").Select
Selection.Font.ColorIndex = 3
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Range("G6").Select
End Sub
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.html" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_HTML_TABLE(strFNAME, objTARGET)
'できたファイルをIEで表示して確認する
Call IE_OPEN_URL(strFNAME) 'ファイル名を渡す
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub
'ファイル名とセルの範囲RANGEを受け取り、
'ファイルを開きHTMLのテーブルを作成する
Sub MAKE_HTML_TABLE(strFNAME As String, objHANI As Range)
Dim strCOLOR As String
Dim strR As String
Dim strG As String
Dim strB As String
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成してみました"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>" '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'ALIGNを調べて書き込む
Select Case objHANI.Cells(y, x).HorizontalAlignment
Case xlRight:
Print #FNO, "<TD ALIGN='RIGHT'";
Case xlLeft:
Print #FNO, "<TD ALIGN='LEFT'";
Case xlCenter:
Print #FNO, "<TD ALIGN='CENTER'";
Case Else 'その他設定無しのとき
Print #FNO, "<TD";
End Select
'バックカラーを調べる
strCOLOR = Right("000000" & _
Hex(objHANI.Cells(y, x).Interior.Color), 6)
If strCOLOR <> "FFFFFF" Then '白以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
Print #FNO, " BGCOLOR=#" & strR & strG & strB;
End If
Print #FNO, ">"; 'タグを閉じる
'フォントの色を調べる
strCOLOR = Right("000000" & Hex(objHANI.Cells(y, x).Font.Color), 6)
If strCOLOR <> "000000" Then '黒以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
Print #FNO, "<Font Color=#" & strR & strG & strB & ">";
End If
'セルの中身を書き込む
Print #FNO, objHANI.Cells(y, x).Value;
'フォントのタグを閉じる
If strCOLOR <> "000000" Then '黒以外の時処理
Print #FNO, "</Font>";
End If
'タグを閉じる
Print #FNO, "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub
'URLを受け取り、IEを起動、URLを開く
Sub IE_OPEN_URL(strURL As String)
'IEを起動して、表示
Dim objIE As Object 'IEオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strURL '文字列で指定したURLに飛ぶ
End Sub
Sub codetest()
Dim strMOJI As String
Dim n As Integer
For n = 1 To Len(Range("A1").Value)
strMOJI = Mid(Range("A1").Value, n, 1)
Debug.Print "[" & strMOJI & "]code=" & Hex(Asc(strMOJI))
Next n
End Sub
一文字単位で文字列を調べて、変換してみたいと思います。
文字のループは、
For n = 1 To Len(Range("A1").Value)
strMOJI = Mid(Range("A1").Value, n, 1)
Debug.Print "[" & strMOJI & "]code=" & Hex(Asc(strMOJI))
Next n
みたいに、Lenで文字数を求めて、Mid関数で1文字単位に取り出して、
特殊文字を判断して変換してみます。
単純に作ると、
'文字列を受け取り、変換結果を返す
Function htmlEnCode(strMOTO As String) As String
Dim strCHK As String 'チェックする文字
Dim strSET As String 'セットする文字
Dim strWORK As String '結果を入れる作業変数
Dim n As Integer 'カウンター
'結果をまず初期化する
strWORK = ""
'文字数分ループする
For n = 1 To Len(strMOTO)
strCHK = Mid(strMOTO, n, 1) 'チェックする文字を取り出す
Select Case Asc(strCHK) '文字をチェックする
Case &H20: strSET = " " 'スペース
Case &H3C: strSET = "<" '<
Case &H3E: strSET = ">" '>
Case &H26: strSET = "&" '&
Case &H22: strSET = """ '"
Case &HA: strSET = "<br>" '改行
Case Else: strSET = strCHK 'その他の文字はそのままセット
End Select
'文字列を作る
strWORK = strWORK & strSET
Next n
'作られた文字列をリターン値としてセットする
htmlEnCode = strWORK
End Function
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.html" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_HTML_TABLE(strFNAME, objTARGET)
'できたファイルをIEで表示して確認する
Call IE_OPEN_URL(strFNAME) 'ファイル名を渡す
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub
'ファイル名とセルの範囲RANGEを受け取り、
'ファイルを開きHTMLのテーブルを作成する
Sub MAKE_HTML_TABLE(strFNAME As String, objHANI As Range)
Dim strCOLOR As String
Dim strR As String
Dim strG As String
Dim strB As String
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'HTMLのヘッダーを書く
Print #FNO, "<HTML><HEAD><TITLE>"
Print #FNO, "テーブル作成してみました"
Print #FNO, "</TITLE></HEAD>"
Print #FNO, "<BODY>"
Print #FNO, "<TABLE border=1>" 'テーブルの開始
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, "<TR>" '行の開始タグ
For x = 1 To objHANI.Columns.Count '列のループ
'ALIGNを調べて書き込む
Select Case objHANI.Cells(y, x).HorizontalAlignment
Case xlRight:
Print #FNO, "<TD ALIGN='RIGHT'";
Case xlLeft:
Print #FNO, "<TD ALIGN='LEFT'";
Case xlCenter:
Print #FNO, "<TD ALIGN='CENTER'";
Case Else 'その他設定無しのとき
Print #FNO, "<TD";
End Select
'バックカラーを調べる
strCOLOR = Right("000000" & Hex(objHANI.Cells(y, x).Interior.Color), 6)
If strCOLOR <> "FFFFFF" Then '白以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
Print #FNO, " BGCOLOR=#" & strR & strG & strB;
End If
Print #FNO, ">"; 'タグを閉じる
'フォントの色を調べる
strCOLOR = Right("000000" & Hex(objHANI.Cells(y, x).Font.Color), 6)
If strCOLOR <> "000000" Then '黒以外の時処理
strR = Mid(strCOLOR, 5, 2)
strG = Mid(strCOLOR, 3, 2)
strB = Mid(strCOLOR, 1, 2)
Print #FNO, "<Font Color=#" & strR & strG & strB & ">";
End If
'セルの中身を変換して書き込む*018で追加
Print #FNO, htmlEnCode(objHANI.Cells(y, x).Value);
'フォントのタグを閉じる
If strCOLOR <> "000000" Then '黒以外の時処理
Print #FNO, "</Font>";
End If
'タグを閉じる
Print #FNO, "</TD>";
Next x
Print #FNO, "</TR>" '行の終了タグ
Next y
'HTMLのタグを閉める
Print #FNO, "</TABLE>"
Print #FNO, "</BODY></HTML>"
'ファイルをクローズする
Close #FNO
End Sub
'URLを受け取り、IEを起動、URLを開く
Sub IE_OPEN_URL(strURL As String)
'IEを起動して、表示
Dim objIE As Object 'IEオブジェクト参照用
'インターネットエクスプローラーのオブジェクトを作る
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True '見えるようにする(お約束)
objIE.Navigate strURL '文字列で指定したURLに飛ぶ
End Sub
'文字列を受け取り、変換結果を返す
Function htmlEnCode(strMOTO As String) As String
Dim strCHK As String 'チェックする文字
Dim strSET As String 'セットする文字
Dim strWORK As String '結果を入れる作業変数
Dim n As Integer 'カウンター
'結果をまず初期化する
strWORK = ""
'文字数分ループする
For n = 1 To Len(strMOTO)
strCHK = Mid(strMOTO, n, 1) 'チェックする文字を取り出す
Select Case Asc(strCHK) '文字をチェックする
Case &H20: strSET = " " 'スペース
Case &H3C: strSET = "<" '<
Case &H3E: strSET = ">" '>
Case &H26: strSET = "&" '&
Case &H22: strSET = """ '"
Case &HA: strSET = "<br>" '改行
Case Else: strSET = strCHK 'その他の文字はそのままセット
End Select
'文字列を作る
strWORK = strWORK & strSET
Next n
'作られた文字列をリターン値としてセットする
htmlEnCode = strWORK
End Function