ミスチルの大名曲の数々が配信決定!! 31日間無料!!【PR】

お世話になります。

ExcelのVBAでテキストにタグをつけてxml形式で書き出すようにしたのですが、xmlの始めの文章で

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

で文字コード?を指定しているために書き出されたxmlをドリームウェーバーで開くと平仮名などの中身の文字が化けます。
MacのOSXを使っているためなのか、ADODBが使えないようです。


参考までにこんなプログラムです↓

Sub kaki_TextFile2()

Const cnsFILENAME = "a.xml"
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 書き出すレコード内容
Dim GYO As Long ' 収容するセルの行
Dim GYOMAX As Long ' データが収容された最終行

Worksheets("最終データ").Activate

' 最終行の取得
GYOMAX = Range("A65536").End(xlUp).Row
' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(出力モード)
Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF
' 2行目から開始
GYO = 2
' 最終行まで繰り返す
Do Until GYO > GYOMAX
' A列内容をレコードにセット(先頭は2行目)
strREC = Cells(GYO, 1).Value
' レコードを出力
Print #intFF, strREC
' 行を加算
GYO = GYO + 1
Loop
' 指定ファイルをCLOSE
Close #intFF
End Sub

といってもこちらから抜粋させていただいただけなのですが…

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

VBもxmlも初心者同然なので、、、すみませんがよろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (6件)

Windowsの場合、Print文で出力される文字コードはCP932=Shift_JISになる


のですが、Macの場合もShift_JISになるのですかね?
(日本語をPrint文で出力して、バイナリエディタで文字コードを調べれば
確認できるはず)

いっそのこと、String変数にはUnicodeで持っている(※)わけなので、
BinaryモードでUnicodeをはけば確実ではないでしょうか?

※ MsgBox AscW("あ") → 12354 → &H3042 で確認できるはず
(Shift_JISの"あ"は &H82a0となる)

# 最悪、encoding=UTF-8でもUnicodeエスケープすればできるかも。
# <?xml version="1.0" encoding="utf-8"?>
# <a>&#x3042;</a>
# ってのは 3042 は "あ" のUnicodeだが、ちゃんと表示できる。


もしくは、MacのExcelのバージョンが良くわからないのでできるかわかりませんが、
出力するものをすべてSheetに吐き出し、Unicodeのテキストファイルとして出力するとか。
(たぶんこれができれば一番楽)
    • good
    • 0
この回答へのお礼

お返事ありがとうございます。
本当に申し訳ないのですが、もう少しわかりやすく説明していただいてもよろしいでしょうか?
MsgBox AscW("あ")をイミディエイトで実行すると12354という結果が表示されたのですが
それをバイナリエディタに通せばいいのでしょうか?

最後の#最悪~~というところは全然理解ができなくて…すいません;;

ちなみにExcelは
Excel2004 for mac、
Microsoft visual basic 
共にバージョン11.0です。

お礼日時:2009/05/28 11:16

この検証用にちょうどよいMAC用バイナリエディタを見つけました。


「HexEditor」は文字のエンコーディングを指定して、表示させることができるそうです。
http://park.zero.ad.jp/pautha/hexeditor.html

MACには Microsoft XML V.xx みたいなdllは無いですよね?
    • good
    • 0

>Print #intFF, strREC ' レコードを出力


で出力したらMacでは文字コードがどうなるか確認してもらいたいわけです。

単純な文字列を吐き出し、出来上がったテキストファイルをバイナリエディタで
みたとき、どうなっているか
ということです。
    • good
    • 0

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>で、


そのXMLで使用される文字コードはUTF-8だと宣言しています。
これをもってXMLの文字コードを判定しているソフトもあれば、そうでない
ソフトもあります。
WindowsのEXCELで使われている文字コードはShift-JISです。
Print文は文字コードの変換をしないと思うのですが、
だから抜本的におかしいです。
そのXMLをどう使うのかわかりませんが、
<?xml version="1.0" encoding="Shift-JIS" standalone="yes"?>
と換えるのはだめなんですか?
    • good
    • 0
この回答へのお礼

ありがとうございます。
でき上がったxmlを利用するときに、文字コードはUTF-8でないといけないそうです。
なので、その方法は使えそうになさそうです。
わざわざありがとうございます。

お礼日時:2009/05/28 10:57

>書き出されたxmlを全部コピーして上記が既に入力されているxmlファイルにペースト



という状態であれば、
Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF
これを書き換えたいファイル名に変更してあげれば動作するのでは?

Dim Fname As String

Fname = Application.GetOpenFilename("XMLファイル,*.xml")
If Fname = "False" Then Exit Sub

上記を最初に行って書き換えたいXMLファイルを取得して、
Open Fname For Output As #intFF

とすればうまくいきそうな感じに受け取れるのですが。
    • good
    • 0
この回答へのお礼

ありがとうございます。
やってみたのですがうまく動作しませんでした( Application...でエラーがでます)
私のやり方が悪いのかもしれませんのでこんな感じにしたのですが↓

'Sub kaki_TextFile2()

Const cnsFILENAME = "a.xml"
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 書き出すレコード内容
Dim GYO As Long ' 収容するセルの行
Dim GYOMAX As Long ' データが収容された最終行
Dim Fname As String

Worksheets("最終データ").Activate ' シートの指定


Fname = Application.GetOpenFilename("XMLファイル,panaa.xml")
If Fname = "False" Then Exit Sub

GYOMAX = Range("A65536").End(xlUp).Row ' 最終行の取得
intFF = FreeFile ' FreeFile値の取得(以降この値で入出力する)

Open Fname For Output As #intFF ' 指定ファイルを開く


GYO = 2 ' 2行目から開始

Do Until GYO > GYOMAX ' 最終行まで繰り返す
strREC = Cells(GYO, 1).Value ' A列内容をレコードにセット(先頭は2行目)
Print #intFF, strREC ' レコードを出力
GYO = GYO + 1 ' 行を加算
Loop
Close #intFF
' 指定ファイルをとじる



関係ないのかもしれませんが、最初に書き込んだものを実行するとファイル名がフォルダ名を参照して一つ前の階層に保存されます。
ex)
デスクトップ/p(フォルダ)/Excelファイル

デスクトップ/pa.xml

お礼日時:2009/05/28 10:54

とりあえず普通のエディタで文字化けしないものを作りましょう。


xml 文字化けなどでググリましょう。

で、化けないようなxmlファイルが作れたら、
そのフォーマットにしたがって自動化してください。

一気にやるのは無茶です。一つ一つ課題をクリアしましょう
    • good
    • 0
この回答へのお礼

早いお返事ありがとうございます。
説明不足で申し訳なかったのですがExcelのシート上で

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

の文字列をいれずに書き出しするとxmlファイルは文字化けしないのです。
対策として…

xml上で文字コードを指定する文(上記)を入力しない状態で書き出す→書き出されたxmlを全部コピーして上記が既に入力されているxmlファイルにペースト

という手段をとっているのですが、なんとか自動化にする手段を探しています…
やはり無理なのでしょうか?

お礼日時:2009/05/26 16:37

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcelVBA テキストファイルUNICODE文字化けについて

1.環境
Microsoft Windows7 64ビット
Microsoft Ofiice2013 Excel2013 32ビット

2.事象
テキストファイルに定義しているUNICODEを読むと文字化け(?)します。
メモ帳等のテキストファイル上はUNICODEを文字化けせずに目視で確認しています。
どうしたら文字化けせずに読めるのでしょうか?
どなたか詳しい方、ご教授願います。

3.テキストファイル(test.dat)


4.VBA
・参照設定([ツール(T)]バー-[参照設定(R)…])
レ Microsoft ActiveX Data Objects 2.8 Library

・ソース
※例どっちでも、文字化けします。
Dim a, b As String
例1)
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Type = adTypeText
.Open
.LoadFromFile "C:\test.dat"
a = .ReadText
.Close
End With

例2)
Open "C:\test.dat" For Input As #1
Do Until EOF(1)
Line Input #1, b
Loop
Close #1

1.環境
Microsoft Windows7 64ビット
Microsoft Ofiice2013 Excel2013 32ビット

2.事象
テキストファイルに定義しているUNICODEを読むと文字化け(?)します。
メモ帳等のテキストファイル上はUNICODEを文字化けせずに目視で確認しています。
どうしたら文字化けせずに読めるのでしょうか?
どなたか詳しい方、ご教授願います。

3.テキストファイル(test.dat)


4.VBA
・参照設定([ツール(T)]バー-[参照設定(R)…])
レ Microsoft ActiveX Data Objects 2.8 Library

・ソース
※例どっちでも、...続きを読む

Aベストアンサー

できないときは、何か肝心なミスを見逃していることがあります。

>セル自体にUnicodeを対応していると思っています。
Excel 2003の頃から、対応はしているのですが、本格的な対応は、
Excel 2013 前後だと思います。新しい文字関数が増えましたからね。

>入力テキストファイルから出力テキストファイル
これは、ADODB.Stream で対応可能なはずです。

しかし、私の経験では、逆に、セルからの出力テキストの場合は、まったくやり方が違う方法を思いつきました。いずれにしても、私の範囲内では、UTF-8とUTF-16 は、共有しませんから、要注意だと思います。思わぬ失敗をしている時があります。

学ばれるのでしたから、以下のサイトがよいです。
NonSoft というサイトです。
http://nonsoft.la.coocan.jp/SoftSample/SampleModADOS.html

私も、それなりに、この問題をそのサイトを中心に格闘した上でのことですが、ただ、こういう話は、どちらかというと、VB6系よりも次の世代の言語のプログラムに任せたほうが早いのです。さしずめ、PowerShellあたりでも対応可能なのですから、本当に、ばかばかしいと思うぐらいに簡単になってしまいました。

それと、ご存知かもしれませんが、有名なUnix系ツールのnkf32 あたりが、巨大ファイルの変換が思うに任せないようです。私の間違いかもしれませんが。それで、試しに、Notepad++ で、あっけなく変換してしまったので、本当に拍子抜けしてしまいました。

できないときは、何か肝心なミスを見逃していることがあります。

>セル自体にUnicodeを対応していると思っています。
Excel 2003の頃から、対応はしているのですが、本格的な対応は、
Excel 2013 前後だと思います。新しい文字関数が増えましたからね。

>入力テキストファイルから出力テキストファイル
これは、ADODB.Stream で対応可能なはずです。

しかし、私の経験では、逆に、セルからの出力テキストの場合は、まったくやり方が違う方法を思いつきました。いずれにしても、私の範囲内では、UTF-8とUTF-16 ...続きを読む

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QXMLをエクセルに取り込むマクロ

XMLをエクセルで取り込み、表にしたいと考えています。
エクセル2003にて下記のtest.xmlをインポートすると

<?xml version="1.0" encoding="UTF-8" ?>
<McXMLRoot>
<McXMLData>
<McXMLPageData>
<ヘッダ情報>
<作成日>
<value>平成21年 5月28日</value>
</作成日>
<作成時間>
<value>10時55分12秒</value>
</作成時間>
<ページ数>
<value>0001</value>
</ページ数>
</ヘッダ情報>
<明細情報>
<商品名>
<value>パソコン</value>
</商品名>
<価格>
<value>100000</value>
</価格>
</明細情報>
<明細情報>
<商品名>
<value>プリンタ</value>
</商品名>
<価格>
<value>20000</value>
</価格>
</明細情報>
</McXMLPageData>
</McXMLData>
</McXMLRoot>

エクセルでタイトルがvalue,value2…,value5 のように表示されます。
作成日,作成時間,ページ数,商品名,価格
のように表示するためのマクロを作成しようとしているのですが、

Public Const XmlPass = "D:\WORK\test.xml"
Public Sub Auto_Open()
ActiveWorkbook.XmlImport URL:=XmlPass _
, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
End Sub

で取り込んだあと、どのように処理すればよいのでしょうか?
(1)テキストとして読み込む
(2)<value>のすぐ前にあるタイトル部分を検索
(3)タイトル部分を切り出す。
(4)指定のセルにタイトルをセット

とすると、切り出したタイトルの文字コードがUTF-8のため
文字化けしてしまいます。

Private Sub setTitle()
Dim FileNoRead%
Dim wkFree$
Dim result1 As Integer
Dim result2 As Integer
Dim result3 As Integer
Dim Title(300) As String
Dim Soeji As Integer
Dim Kaishi As Integer
Dim SWork As String

Soeji = 0
Kaishi = 1

FileNoRead% = FreeFile
' テキストのオープン
Open XmlPass For Input Access Read As #FileNoRead%

' テキストの読込
Line Input #FileNoRead%, wkFree$ 'ファイルから1行読み込む

' テキストのクローズ
Close #FileNoRead%

Do While True
Soeji = Soeji + 1
result1 = InStr(Kaishi, wkFree$, "<value>") '<value>出現位置
result2 = InStrRev(wkFree$, ">", result1) + 1 'タイトル終了位置
result3 = InStrRev(wkFree$, "<", result2) + 1 'タイトル開始位置
SWork = Mid(wkFree$, result3, (result1 - result2))

Title(Soeji) = SWork
Kaishi = InStr(result1, wkFree$, "</value>") '</value>出現位置
Kaishi = Kaishi + 8
Loop

End Sub


ほかに何かよい方法があったら教えてください。

P.S)作りはじめのため、バグ多数存在します。

XMLをエクセルで取り込み、表にしたいと考えています。
エクセル2003にて下記のtest.xmlをインポートすると

<?xml version="1.0" encoding="UTF-8" ?>
<McXMLRoot>
<McXMLData>
<McXMLPageData>
<ヘッダ情報>
<作成日>
<value>平成21年 5月28日</value>
</作成日>
<作成時間>
<value>10時55分12秒</value>
</作成時間>
<ページ数>
<value>0001</value>
</ページ数>
</ヘッダ情報>
<明細情報>
<商品名>
<value>パソコン</value>
</商品名>
<価格>
<value>100000</value>
</価格>
</明細...続きを読む

Aベストアンサー

「このとき<明細情報>はセットできますが、<ヘッダ情報>はどのようにセットするのでしょうか?」
No2です。<ヘッダ情報>がセットされないのは、
Set nlist = ObjXml.selectNodes("//明細情報/*")
で、<明細情報>以下の要素しかnlistに入れてないからです。
<ヘッダ情報>以下をnlistにセットするなら、
Set nlist = ObjXml.selectNodes("//ヘッダ情報/*")
としてXpathで選ぶか、又はルートからたどって
Set nlist = ObjXml.childNodes(1).childNodes(0).childNodes(0).childNodes(0).childNodes
として選ぶか、又はTagName指定で
Set nlist = ObjXml.getElementsByTagName("ヘッダ情報")
Set nlist = nlist(0).childNodes
と選びます。選んだ上で、
For Each node In nlist
msgbox node.nodeName & _
node.childNodes(0).childNodes(0).nodeValue
Next node
として、項目名と内容を取得できます。
「文字コードは勝手に変換してくれてます(本当かな?)」
ヘッダーの項目の数は nlist.Length になります。

「このとき<明細情報>はセットできますが、<ヘッダ情報>はどのようにセットするのでしょうか?」
No2です。<ヘッダ情報>がセットされないのは、
Set nlist = ObjXml.selectNodes("//明細情報/*")
で、<明細情報>以下の要素しかnlistに入れてないからです。
<ヘッダ情報>以下をnlistにセットするなら、
Set nlist = ObjXml.selectNodes("//ヘッダ情報/*")
としてXpathで選ぶか、又はルートからたどって
Set nlist = ObjXml.childNodes(1).childNodes(0).childNodes(0).childNodes(0).childNodes
として選ぶ...続きを読む

QLine Inputで文字化け(助けて下さい)

素人な質問ですみません。

Line Input #fpFileNo, strMsgBuffA

上記手法により、txtファイルから1行ずつレコードを
取り出していますが、
先頭が”全角文字”のレコードを取り出すと
先頭文字が”文字化け”します。

正しく全角文字が取り出せる手法を教えてください。

Aベストアンサー

ウィス! 今日は午後出社ダヨ
昨日は用事があって、きちんと最後まで説明できなかったダヨ。

Open strFile For Binary As #intFile
  Get #intFile, , bytBuff
Close #intFile
までは一緒

先頭から1~10バイトがShiftJIS
文字変数 = strconv(MIDB(bytBuff,1,10),vbunicode)

先頭から11~14バイトがバイナリ
redim バイト変数(3) as byte
バイト変数 = MIDB(bytBuff,11,4)
これで先頭の一行の改行コード直前までの値を取得したことになる。

ついでにいうと先頭から15~16バイトが改行コード
strconv(MIDB(bytBuff,15,2),vbunicode) = 改行コード(vbcrlf)
だから17バイト目からXレコードが始まることになる。

Xレコードを取るためには
MIDB(bytBuff,17,文字変数より取得したXレコード長)
とすると取れるはず。

バイナリと言ってもいろいろあるので、どんなデータが入っているのかわからないから、キャストしやすいバイト変数をサンプルに挙げたけど、必要に応じて違う変数を宣言する必要あり。

ウィス! 今日は午後出社ダヨ
昨日は用事があって、きちんと最後まで説明できなかったダヨ。

Open strFile For Binary As #intFile
  Get #intFile, , bytBuff
Close #intFile
までは一緒

先頭から1~10バイトがShiftJIS
文字変数 = strconv(MIDB(bytBuff,1,10),vbunicode)

先頭から11~14バイトがバイナリ
redim バイト変数(3) as byte
バイト変数 = MIDB(bytBuff,11,4)
これで先頭の一行の改行コード直前までの値を取得したことになる。

ついでにいうと先頭から15~16バイ...続きを読む

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QDoEvents関数って何?

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そこで「EXCEL VBA パーフェクトマスター」という本を見たら

for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
DoEvents
next i
unload userform1
と入力すれば解決することがわかりました。

しかし「DoEvents」についてあまり詳しく書いていなかったのでDoEvents関数をヘルプで見ると、
「発生したイベントがオペレーティング システムによって処理されるように、プログラムで占有していた制御をオペレーティング システムに渡すフロー制御関数です。」

と書いてあるのですが正直、書いてあることがよくわかりません。

どなたかDoEvents関数について、
もう少しわかりやすく教えていただけませんか。
それから、最初に書いたコードで実行すると
ユーザーフォームの背景が真っ白になってしまう原因も
教えていただけませんか?

よろしくお願いいたします。

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そ...続きを読む

Aベストアンサー

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
    DoEvents
    Cells(i,1) = ""
  Next i
End Sub

Private Sub CommandButton2_Click()
  MsgBox "hoge"
End Sub

っていうフォームのコードがあった場合、
DoEvents を入れることによって、ループ中にユーザーがCommandButton2 を押すことによって CommandButton2 のクリック イベントも動いちゃいます。
CommandButton1 のクリック イベントではループの前に
CommandButton1.Enabled = False
CommandButton2.Enabled = False
を書いてフォーム上の CommandButton を無効にしておき、ループが終わったら
CommandButton1.Enabled = True
CommandButton2.Enabled = True
と書いて CommandButton を有効に戻してください。

これを工夫すれば、CommandButton2 で CommandButton1 のループを途中キャンセルする処理もすることができます。

Private Canceled As Boolean

Private Sub CommandButton1_Click()

  CommandButton2.Enabled = False

  Dim i As Long
  For i = 1 To 50000
    DoEvents

    If Canceled = True Then
      MsgBox "キャンセルしました"
      Exit Sub
    End If

    Cells(i, 1).Value = ""
  Next i
End Sub

Private CommandButton2_Click()
  Canceled = True
End Sub



コードの行頭にあるスペースは見易さのために全角スペースで作成していますので、これをこのままコピペするとエラーになるかもしれません。
コピペするなら行頭の全角スペースを半角スペースに直してください。

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
...続きを読む

QエクセルVBAでテキストボックスの値の取得と変更について

エクセルのVBAを使ってシート上のテキストボックスのテキストを取得・変更するマクロを作成したいと思っていますがうまく行きませんので、お知恵を拝借したいとおもいます。

環境:WindowsXPでオフィス2002
状況:
エクセルブックa.xlsのシートに「コントロールツールボックス」のテキストボックスを配置(オブジェクト名はTEXTBOX_C)
エクセルブックb.xlsにコードを書き、a.xlsのTEXTBOX_CのプロパティのValueかTextを取りだしたい

試した事:
コントロールを配置したシートに次のマクロ
TEXTBOX_C.Text = "これはコントロールのテキストボックス"
を書くとテキストボックスに文字を入れ込めますが、別のエクセルブックからだと上手く行きません。

また、オートシェイプのテキストボックスの場合は簡単に出きるのですが、コントロールツールボックスではどうしても上手く行きませんので、対象法などご存知の方いらっしゃいましたら教えてください

Aベストアンサー

エクセルを新規に開きました。
そのSheet1に(コントロールツールボックスの)TextBoxを貼りつけました。
そのBook1から、ファイル-開くで別ブックを開きました。
別ブックのMojule1側に下記を書いて
Sub test02()
MsgBox Workbooks("book1").Worksheets("sheet1").textbox1.Text
End Sub
を実行すると、Book1のTextBoxに入れた文字列が表示
されました。
がそんな質問ではないのですか。

Q【VBA ・ エクセル】 テキストファイルから特定情報をぬきだすには

下記のようなテキストファイルから、山田太郎の後ろの数値のみを、エクセルのシートに抜き出すにはどのようにしたらよいのでしょうか。

A1セルに30、A2セルに40、A3セルに60、のように入力したいです。よろしくおねがいします。

山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点

Aベストアンサー

例データ
山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点
これをメモ帳に貼り付け、名前をtest7.txtで保存しました。名前は自由です。
エクセルのVBEに標準モジュールに
Sub test01()
s = "山田太郎"
i = 2
Open "C:\Documents and Settings\XXXX\My Documents\test7.txt" For Input As #1
While Not EOF(1)
Line Input #1, a
If Left(a, Len(s)) = s Then
Cells(i, "A") = s
Cells(i, "B") = Right(a, Len(a) - Len(s))
i = i + 1
End If
Wend
Close #1
End Sub
を貼り付け、実行しました。
アクチブシートに
A列  B列
山田太郎 30点
山田太郎 40点
山田太郎 60点
となりました。

例データ
山田太郎 30点
aaaaaa30aaaaaaaaaaa
bbbbbb20bbbbbbbbbbb
ccccccccccccccccccc
山田太郎 40点
ssssss30sssssss
eeeeeee40eeeeeeeeee
fffffffffffffffffffffff
山田太郎 60点
これをメモ帳に貼り付け、名前をtest7.txtで保存しました。名前は自由です。
エクセルのVBEに標準モジュールに
Sub test01()
s = "山田太郎"
i = 2
Open "C:\Documents and Settings\XXXX\My Documents\test7.txt" For Input As #1
While Not EOF(1)
Line Input #1, a
If Left(a, Len(s)) = s ...続きを読む

QVBAのコマンドボタンの文字列の改行方法は?

EXCEL2000のVBAでコマンドボタンを使っていますが、ボタンの横サイズは大きくできないときに、ボタンの文字列(caption)が長いので表示が途中で切れてしまう。WordWrapをtrueにすると改行するが、任意の文字位置で改行できない。スペース文字を途中で挿入して改行位置を調整しようとしてもうまくいかない。任意の位置で改行する方法はありますか。

Aベストアンサー

コマンドボタンのプロパティの『Caption』欄ではなく、コマンドボタン上での直接編集なら、
Shiftキー+Enterキーの同時押しで、任意の位置に改行を挿入できます。

具体的な手順を以下に説明します:
 1)『コントロール ツールボックス』ツールバーの左端にある『デザイン モード』ボタンを
  クリックして、デザインモードに切り替える
 2)改行を入れたいコマンドボタンを右クリック
 3)右クリックメニューから「コマンドボタン オブジェクト(O)→編集(E)」を選択
 4)コマンドボタン上にカーソルが表示されるので、改行させたい位置に移動
 5)Shiftキーを押しながらEnterキーを入力

・・・以上です。

QExcel VBA読み込みで文字化けが

Excel VBAにてメールデータを読み込むプログラムを組んでいます。
データの作り方は、
(1)Mozilla Thunderbirdでメールデータをtext形式で保存
(2)VBAにてtextデータを開く。

しかし読み込みを行うと、文字化けしたデータが表示されてしまいます。

どのように解決したらよいのでしょうか?
文字コード変換を行ってもダメでした。

Sub Read_mail_data()
Const cnsTITLE = "テキストファイル読み込み処理"
Const cnsFILTER = "全てのファイル (*.*),*.*"
Dim xlAPP As Application ' Applicationオブジェクト
Dim intFF As Integer ' FreeFile値
Dim strFileName As String ' OPENするファイル名(フルパス)
Dim vntFileName As Variant ' ファイル名受け取り用
Dim strREC As String ' 読み込んだレコード名
Dim GYO As Long ' 収容するセルの行
Dim lngREC As Long ' レコード件数カウンタ

' Applicationオブジェクト取得
Set xlAPP = Application
' 「ファイルを開く」のダイアログでファイル名の指定を受ける
xlAPP.StatusBar = "読み込むファイル名を指定して下さい。"
vntFileName = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE)
' キャンセルされた場合はFalseが返るので以降の処理は行わない
If VarType(vntFileName) = vbBoolean Then Exit Sub
strFileName = vntFileName

' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(入力モード)
Open strFileName For Input As #intFF
GYO = 1
' ファイルのEOF(End of File)まで繰り返す
Do Until EOF(intFF)
' レコード件数カウンタの加算
lngREC = lngREC + 1
xlAPP.StatusBar = "読み込み中です....(" & lngREC & "レコード目)"
' 改行までをレコードとして読み込む
Line Input #intFF, strREC
' 行を加算しA列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
' 文字コードを変換する
'StrConv(strREC, vbFromUnicode) = a
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
Cells(GYO, 1).Value = StrConv(strREC, vbFromUnicode)
' セルにデータを書き込む
'Cells(GYO, 1).Value = strREC
Loop
' 指定ファイルをCLOSE
Close #intFF
xlAPP.StatusBar = False
' 終了の表示
MsgBox "ファイル読み込みが完了しました。 " & vbCr & "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE

End Sub

Excel VBAにてメールデータを読み込むプログラムを組んでいます。
データの作り方は、
(1)Mozilla Thunderbirdでメールデータをtext形式で保存
(2)VBAにてtextデータを開く。

しかし読み込みを行うと、文字化けしたデータが表示されてしまいます。

どのように解決したらよいのでしょうか?
文字コード変換を行ってもダメでした。

Sub Read_mail_data()
Const cnsTITLE = "テキストファイル読み込み処理"
Const cnsFILTER = "全てのファイル (*.*),*.*"
Dim xlAPP As Application ' Applicationオ...続きを読む

Aベストアンサー

文字化けの原因が文字コードのためだと・・仮定して。
Ado.Stream で読み込んだらどうなりますかね。

Sub testAdoStream()
Dim objStrm As Object
Dim strTmp As String
Dim i As Integer
Const ReadLine As Integer = -2, ReadAll As Integer = -1
Set objStrm = CreateObject("ADODB.Stream")

With objStrm
.Charset = "ISO-2022-JP"
.LineSeparator = -1 'CR=13, LF=10, CRLF=-1
.Open
.LoadFromFile "D:\ThunderbirdMAIL.txt"
End With

Do Until objStrm.EOS
i = i + 1
Cells(i, 1) = objStrm.ReadText(ReadLine)
Loop
objStrm.Close: Set objStrm = Nothing
End Sub

なお、Charset の "ISO-2022-JP" はあてずっぽうです。
Thunderbird は使ったことが有りませんので、ここまで。

文字化けの原因が文字コードのためだと・・仮定して。
Ado.Stream で読み込んだらどうなりますかね。

Sub testAdoStream()
Dim objStrm As Object
Dim strTmp As String
Dim i As Integer
Const ReadLine As Integer = -2, ReadAll As Integer = -1
Set objStrm = CreateObject("ADODB.Stream")

With objStrm
.Charset = "ISO-2022-JP"
.LineSeparator = -1 'CR=13, LF=10, CRLF=-1
.Open
.LoadFromFile "D:\ThunderbirdMAIL.txt"
End Wit...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング