VB6.0からEXCELのセル内文字列のサイズを操作すると、複数回操作したところで失敗してしまう

質問

VB6.0で、EXCELを編集し印刷するプログラムを作成しており、セル内の半角文字列を均等割り付けしたいと
考えています。

Excelでは、半角数字のみで構成された文字列の均等割り付けができませんが、文字の間にスペースを
入れることで均等割り付けが働くようになります。

そこでVBのプログラムより、既存ファイルのセルに半角数字と半角スペースを交互に80文字ほどセットし、
その後に半角スペースの文字サイズのみを1にする処理を下記のように記述したのですが、20～30文字
くらい処理したところで実行時エラーが発生してしまいます。

　Set xlsApp = CreateObject("Excel.Application")
　Set xlsBook = xlsApp.Workbooks.Open(ファイル名)
　Set xlsSheet = xlsBook.Worksheets(1)

　With xlsSheet
　　…
　　strTemp = ""
　　For i = 1 To Len(strText)　　　'1文字おきにスペースを挟む
　　　strTemp = strTemp & Mid(strText, i, 1)
　　　If i <> Len(strText) Then
　　　　strTemp = strTemp & " "
　　　End If
　　Next i
　　.Cells(10, 7).Value = strTemp

　　'途中に挟んだスペースのサイズを1にする
　　For i = 2 To Len(strTemp) Step 2
　　　.Cells(10, 7).Characters(i, 1).Font.Size = 1　　←実行時エラーはここで出ます
　　Next i
　　…
　End With

エラーの内容は、
　実行時エラー　-2147417851（80010105）
　'~' メソッドは失敗しました： '~'オブジェクト
です。

どうやら、このエラーが出たときはExcelがフリーズしたような状態になっているようでした
（×ボタンを押しても反応がなく、セル等の入力もできないが、ブックは×ボタンで閉じることができ、
ブックを閉じるとExcelも終了します。が、タスクマネージャを見るとプロセスは残っています）。また、
実行時エラーが発生するループ箇所をコメントにすると、エラーは発生しなくなります。

数種類のPCで試したのですが、全く同じ条件のPCでもエラーが発生するものとしないものがあり、
原因がわからずに困っています。なお、試したPCはOSがすべてWindowsXP、Excelのバージョンは
2000と2003です。プログラムはディストリビューションウィザードで作成したインストーラを使って
配布しています。また、Excel Objectの参照設定は外してコンパイルしています。

記述方法がよくないのでしょうか？みなさまのお知恵を拝借できれば幸いです。

回答No.2

Hayashi_Trek · ベストアンサー

これが原因かはわからないのですが、エクセルがハングするのが似ているので。

参考URL：

http://support.microsoft.com/kb/414107/ja

お礼

ご回答ありがとうございます。

現象としては、まさにこんな感じです。KBにはサンプルコードでは16382回のループで停止する、と
回数固定で書いてありますが、当方のコーディングで実行時エラーが出るPCでは、何回処理しても
必ず同じループ回数でエラーを吐きます。エラーが出るループ回数は、PCごとに違うのですが…

回避法として
　　配列を使用して…
とありますが、今回のコーディングでは適用できませんね…　残念です。

回答No.5

onlyrom

回答４、onlyromです。

何でも試してみるということで
Rangeオブジェクトをオブジェクト変数にセットして。。。

　Set myCell = .Cells(10, 7)

　For i = 2 To Len(strTemp) Step 2
　　　myCell.Characters(i, 1).Font.Size = 1
　Next i

以上。

お礼

ご回答ありがとうございます。

ご提示の方法、試してみました。
残念ながら、エラーは消えませんでした…

今日は時間がなくてNo.3の方法は試せませんでしたので、
週明けに試してみて結果をNo.3に書き込みます。

回答No.4

onlyrom

原因が分からないままでは何ですが。。。

エラーの出ない文字ずつ（例えば、２０文字ずつ）やってみたらどうなるでしょうか。

　For i = 2 To 20 Step 2
　　.Cells(10, 7).Characters(i, 1).Font.Size = 1
　Next i
　For i = 22 To 40 Step 2
　　.Cells(10, 7).Characters(i, 1).Font.Size = 1
　Next i

・・・・・・以下同様に・・Len(strTemp) まで・・

以上。

お礼

ご回答ありがとうございます。

ご指摘いただいた方法、試してみました。
１カ所にまとめて記述するとダメでしたが、プロシージャ内に分散させて配置するとうまくいきました。

ただ、この状態では保守性がよくないので、他に何か回避方法を模索してみます。

補足

その後、いろいろ模索し、下記の方法を発見しました。

ExcelブックにExcelVBAマクロで質問のコードを入れてやり、VBからはそのマクロを起動する
だけにしたところ、実行時エラーが回避できました。

Excelブックを、質問の記述のとおり
　Set xlsApp = CreateObject("Excel.Application")
　Set xlsBook = xlsApp.Workbooks.Open(ファイル名)
　Set xlsSheet = xlsBook.Worksheets(1)
でオープンすると、「マクロを無効にする」等のマクロの警告ダイアログは表示されないので、
ExcelVBAマクロを仕込んでもプログラムの利用者からは操作上何も変化がありません。今回は
この方法で行こうと思います。

みなさま、ご回答ありがとうございました。

回答No.3

nda23

私の環境（WindowsXP SP3 + Excel2003）では問題は発生しません。
With を止めてみると直るかも・・・

お礼

ご回答ありがとうございます。

実は、私の環境（WindowsXP SP2 + Excel2000）でも問題は発生しないのです。他のPCにインストールすると
エラーを吐くことがあるので、
　コーディング →
　インストーラ作成 →
　エラーの出るPCのHDDリカバリ → 　
　インストール →
　テスト
の繰り返しです…

> With を止めてみると直るかも・・・
withなしも試してみたのですが、エラーは消えませんでした。

回答No.1

nda23

何をしたいのか分かりません。
均等割り付けの文字列の間に挟んだ空白のフォントサイズを変えても
見かけ上、何の変化もないと思いますが・・・

あと、以下は
　　For i = 1 To Len(strText)　　　'1文字おきにスペースを挟む
　　　　strTemp = strTemp & Mid(strText, i, 1)
　　　　If i <> Len(strText) Then
　　　　　　strTemp = strTemp & " "
　　　　End If
　　Next i
　　.Cells(10, 7).Value = strTemp
　　　　　　　↓
　　For i = 1 To Len(strText)　　　'1文字おきにスペースを挟む
　　　　strTemp = strTemp & Mid(strText, i, 1) & " "
　　Next i
　　.Cells(10, 7).Value = Trim(strTemp)　'前後の空白を除去
でも良いのでは？

お礼

ご回答ありがとうございます。

> .Cells(10, 7).Value = Trim(strTemp)　'前後の空白を除去
> でも良いのでは？

コーディングしているときは気がつきませんでしたが、確かにそのとおりですね。さっそく適用したいと思います。

補足

> 均等割り付けの文字列の間に挟んだ空白のフォントサイズを変えても
> 見かけ上、何の変化もないと思いますが・・・

説明不足でした。こういうことです。

　半角55文字程度が入力可能なセルがあります。このセルに、半角で44文字の数値を入れ、
　それを均等割り付けにしたいのです。数値とスペースを交互に入れた文字列では87文字と
　なってしまい、均等割り付けはおろかセルに収まりすらしません。事情があり、数値の
　フォントサイズは11で固定としなければならなく、セルのサイズも固定であるため、
　スペースのサイズを小さくして均等割り付け、という方法を採ったのです。