現象
os winxpsp3 excel2003sp3 vbaで
DAOでcsvをオープンしようとき発生
こんなコード
Set objDB = OpenDatabase(DEF_LOCALDBDIR, False, False, _
"Text;DATABASE=\\サーバーファイルパス\;hdr=NO;IMEX=1")
解決
参照設定がmicrosoft DAO3.51になってたのをDAO3.6に変えたら症状が出なくなりました。
他やったこと
http://blogs.yahoo.co.jp/abukuma2005/45320694.html
のVisual Studio 6.0 Service Pack 5
を入手してインストールでは解決しなかった
vb6runtimeのインストール
http://hpcgi1.nifty.com/MADIA/VBBBS2/wwwlng.cgi?print+200509/05090075.txt
JET 4.0 Service Pack 8を適用
発生の経緯
ドメイン参加のpcでvbaをテストしてOKで、ドメイン非参加の環境で試すために、ワークグループに変更して症状が出ました。vbaの参照設定を追加する際DAOのバージョンを間違えたようです
まあ、こういうこともあるということで。。
2013年12月20日金曜日
2013年7月27日土曜日
janestyleからevernoteに貼り付ける方法(しょーもないですが)
問題概要
janestyleで2chのスレッドを追っていると、これは記録したいというレス(発言)に出会うことがあります。
そういうとき、janestyleには、直接レスの内容をevernoteに送るコマンドがないので、
どうするかというと、一旦、該当のレスとコピーして、evernoteをたちあげて、新規ノートを作って貼り付けていました。
しかし、めんどい
もっと簡単にコピペ出来る方法を探しました
janestyleの該当レスを選択して「コピー」
win+a
Evernoteをもっと使いこなす! ショートカットキー一覧(Windows編)
実行するコマンド "C:\Program Files (x86)\Evernote\Evernote\Evernote.exe" "/Task:PasteClipboard"
と登録
xpの場合は
"C:\Program Files\Evernote\Evernote\Evernote.exe" "/Task:PasteClipboard"
janestyleの該当レスを選択して「コピー」
右クリックのメニュからevernoteに追加を選ぶ
でevernoteにコピー出来ました
Windows - Evernote Developers http://dev.evernote.com/intl/jp/doc/articles/enscript.php
*コピー操作後でないと転送されません。
*方法1のevernoteのショートカットを使う方法は、evernoteが起動していることが前提です
なので方法1は一手間ステップが多いです
*方法2のコマンドとオプションの間はスペースがひとつ入ります
- 2chスレッドのレスをevernoteに簡単ににコピペしたい
janestyleで2chのスレッドを追っていると、これは記録したいというレス(発言)に出会うことがあります。
そういうとき、janestyleには、直接レスの内容をevernoteに送るコマンドがないので、
どうするかというと、一旦、該当のレスとコピーして、evernoteをたちあげて、新規ノートを作って貼り付けていました。
しかし、めんどい
もっと簡単にコピペ出来る方法を探しました
方法1 evenoteのショートカットを利用する
evernoteを起動janestyleの該当レスを選択して「コピー」
win+a
Evernoteをもっと使いこなす! ショートカットキー一覧(Windows編)
方法2 janestyleのツール-設定-コマンドに
コマンド名 (任意)evernoteに追加 win7の場合実行するコマンド "C:\Program Files (x86)\Evernote\Evernote\Evernote.exe" "/Task:PasteClipboard"
と登録
xpの場合は
"C:\Program Files\Evernote\Evernote\Evernote.exe" "/Task:PasteClipboard"
janestyleの該当レスを選択して「コピー」
右クリックのメニュからevernoteに追加を選ぶ
でevernoteにコピー出来ました
Windows - Evernote Developers http://dev.evernote.com/intl/jp/doc/articles/enscript.php
*コピー操作後でないと転送されません。
*方法1のevernoteのショートカットを使う方法は、evernoteが起動していることが前提です
なので方法1は一手間ステップが多いです
*方法2のコマンドとオプションの間はスペースがひとつ入ります
2013年6月29日土曜日
vba 結合セルから単一セルにコピーするには
複数行を一つにした結合セルから単一セルにコピーすると行数値が飛んでしまう
うーん、わかりにくい。
3
1
2
のようになってしまう。
クリップボードで空白行を削除してコピーして
3
1
2
のようにしたい。
いろいろフリーのクリップボードを操作するものを探したんですが、コマンドラインから操作するものがみつからないんですよね
で、クリップボードから3行毎に読み込んで、貼り付けるvbaを作りました
参考
excel クリップボード(yahoo知恵袋)
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1453559284
使い方は、結合セルの行をコピーして、コピー先の先頭セルにカーソルを置いて
下記vbaを走らせる。
マクロ cntl+a など割り当てて、使ってもらうといいと思います
プログラムの説明
①step 3は結合セルが3行分なので、3行ごとに読み込むとちょうど数字を読み込める
UBound(v2) - 3 uboundは配列数を算出 -3は、該当行をコピーすると、一番最後に""という余分な配列が出来たため、一回分減らしています
"2.0"
" "
" "
"" ←余分
②If Len(v2(i)) = 1 Then v2(i) = 0 は、数字の入っていない行が""で作られ if v2(i)=""でなぜかfalseになって文字長1で判定されるためそのようにしました。数字が入ったセルは3.0や1.0のような形で読み込まれています。””だと次の③で型エラーになったので0に変換。
③Cells(r + rec1, c) = v2(i) * 1は、配列の数字が文字列で書き出されるため*1で数字に直しています
Sub test()
Set CB = New DataObject
CB.GetFromClipboard
v1 = CB.GetText
v2 = Split(v1, Chr(10)) ’←これがすごく参考になった、複数行のクリップボードの内容を配列に格納する
r = ActiveCell.Row
c = ActiveCell.Column
rec1 = 0
For i = 0 To UBound(v2) - 3 Step'①
If Len(v2(i)) = 1 Then v2(i) = 0 '②
Cells(r + rec1, c) = v2(i) * 1 '③
rec1 = rec1 + 1
Next i
End Sub
背景
残業をだすシートの人の並びが結合セルで作ってあり、残業をグラフにするブックのセルが1行毎だったので、コピーだと3行ごとに飛んでしまい、それで、毎回手でグラフのシートに数字を入れていました。
空白行をを削除する、休んだ人も空白行のなるため、一人分飛んでしまう。
それで、3行ごとに読み込む形にしました。
このvbaならコピぺするする感覚でできるのでわかりやすいかなと
残業の人の並びと、グラフの人の並びが同じという前提です。
もともと手で入れていたので、並びも一致させています。
うーん、わかりにくい。
3
1
2
のようになってしまう。
クリップボードで空白行を削除してコピーして
3
1
2
のようにしたい。
いろいろフリーのクリップボードを操作するものを探したんですが、コマンドラインから操作するものがみつからないんですよね
で、クリップボードから3行毎に読み込んで、貼り付けるvbaを作りました
参考
excel クリップボード(yahoo知恵袋)
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1453559284
使い方は、結合セルの行をコピーして、コピー先の先頭セルにカーソルを置いて
下記vbaを走らせる。
マクロ cntl+a など割り当てて、使ってもらうといいと思います
プログラムの説明
①step 3は結合セルが3行分なので、3行ごとに読み込むとちょうど数字を読み込める
UBound(v2) - 3 uboundは配列数を算出 -3は、該当行をコピーすると、一番最後に""という余分な配列が出来たため、一回分減らしています
"2.0"
" "
" "
"" ←余分
②If Len(v2(i)) = 1 Then v2(i) = 0 は、数字の入っていない行が""で作られ if v2(i)=""でなぜかfalseになって文字長1で判定されるためそのようにしました。数字が入ったセルは3.0や1.0のような形で読み込まれています。””だと次の③で型エラーになったので0に変換。
③Cells(r + rec1, c) = v2(i) * 1は、配列の数字が文字列で書き出されるため*1で数字に直しています
Sub test()
Set CB = New DataObject
CB.GetFromClipboard
v1 = CB.GetText
v2 = Split(v1, Chr(10)) ’←これがすごく参考になった、複数行のクリップボードの内容を配列に格納する
r = ActiveCell.Row
c = ActiveCell.Column
rec1 = 0
For i = 0 To UBound(v2) - 3 Step'①
If Len(v2(i)) = 1 Then v2(i) = 0 '②
Cells(r + rec1, c) = v2(i) * 1 '③
rec1 = rec1 + 1
Next i
End Sub
背景
残業をだすシートの人の並びが結合セルで作ってあり、残業をグラフにするブックのセルが1行毎だったので、コピーだと3行ごとに飛んでしまい、それで、毎回手でグラフのシートに数字を入れていました。
空白行をを削除する、休んだ人も空白行のなるため、一人分飛んでしまう。
それで、3行ごとに読み込む形にしました。
このvbaならコピぺするする感覚でできるのでわかりやすいかなと
残業の人の並びと、グラフの人の並びが同じという前提です。
もともと手で入れていたので、並びも一致させています。
2012年12月25日火曜日
サイボーズ 「14603 このフォルダは既に削除されています」とでる
現象
サイボーズにログインしようとすると、「14603 このフォルダは既に削除されています」と出る。
どのユーザーでログインしても、同様の画面になり、戻るを押して、ログイン画面に戻るしかない
他のpcでは正常にログインできる
原因
ブックマークしているurlが
http://(サーバー名)/cbag/ag.exe?page=MyFolderIndex&fid=31
でだった
処理
http://(サーバー名)/cbag/ag.exe
に直したら入れるようになりました
サイボーズにログインしようとすると、「14603 このフォルダは既に削除されています」と出る。
どのユーザーでログインしても、同様の画面になり、戻るを押して、ログイン画面に戻るしかない
他のpcでは正常にログインできる
原因
ブックマークしているurlが
http://(サーバー名)/cbag/ag.exe?page=MyFolderIndex&fid=31
でだった
処理
http://(サーバー名)/cbag/ag.exe
に直したら入れるようになりました
2012年12月21日金曜日
連続でバーコード印刷をすると実行すると、アクティブXコンポーネントはオブジェクトを作成できません になる。vba mibarcode
現象
レコードを読むたびに
Set MiBar = New Mibarcd.Auto
set MiiBar=nothingしていたら
アクティブXコンポーネントはオブジェクトを作成できません
というエラーが、何レコード目かで出る現象が発生。
何レコード目で出るかは不定、また、pcによってエラーが出たり出なかったりした。
このエラーが出る前兆は30秒ほど固また後、上記エラーが出る。
デバッグからvbe(エディター画面)にいってf5を押すと再開される
変更後
バーコード表示用のレコードを読む先頭でSet MiBar = New Mibarcd.Autoを入れて
読み込み終了でset MiiBar=nothingしていたら、処理も早くなってこけなくなった
変更後のサンプルコード
worksheets("納品書").Activate
mai = 0
'レコードを読む前にセット
'Mibarcodeのオートメーションサーバオブジェクトを作成
Set MiBar = New Mibarcd.Auto
x = 0
For Count1 = 0 To co - 1
'レコードを読み込んで納品書シートに書き込み+バーコード作成
GoSub meisub
Next Count1
'印刷範囲を設定する
GoSub prtara
’終了したときオブジェクト破棄
Set MiBar = Nothing
Exit Sub
meisub:
’あらかじめ前のスクリプトで、配列変数にレコード一式読み込んでます。
newdt = ndt(Count1)
newfct = fct(Count1)
newdn = dncd(Count1)
newfct = fct(Count1)
'日付と受け入れ先が変わったら次の伝票へ。日付と受け入れ先が変わるとバーコード変数も変わるようにあらかじめデータをセットしています。
If olddt <> newdt Or x = 6 Or oldfct <> newfct Or olddn <> newdn _
Or oldfct <> newfct Then
'変わったら伝票にバーコードを入れる
GoSub breaksub
End If
'伝票の明細部分の書き出し
Cells((mai - 1) * 14 + x + 5, 1) = hncd(Count1)
Cells((mai - 1) * 14 + x + 5, 2) = hnnm(Count1)
Cells((mai - 1) * 14 + x + 5, 3) = sury(Count1)
Cells((mai - 1) * 14 + x + 5, 4) = tani(Count1)
'Cells((mai - 1) * 14 + x + 5, 5) = tnka(count1)
olddt = newdt
oldfct = newfct
olddn = newdn
oldfct = newfct
x = x + 1
Return
breaksub:
'伝票のヘッダ部分の書き出し
Cells((mai) * 14 + 2, 7) = dncd(Count1)
Cells((mai) * 14 + 12, 2) = hdt(Count1)
Cells((mai) * 14 + 3, 6) = tknm1(Count1)
Cells((mai) * 14 + 4, 7) = tkcd1(Count1)
Cells((mai) * 14 + 4, 2) = ndt(Count1)
Cells((mai) * 14 + 4, 5) = fct(Count1)
' ymdh=date(year(hdt(count1),"0000"),month(hdt(count1),"00"),day(hdt(count1),"00"))
'バーコード作成
GoSub barcode1
x = 1
mai = mai + 1
Return
prtara:
Worksheets("納品書").Activate
prtendr = (mai - 1) * 14 + 14
rangestr = Range(Cells(1, 1), Cells(prtendr, 7)).Address(ReferenceStyle:=xlA1)
ActiveSheet.PageSetup.PrintArea = rangestr
Return
'------------------------------------------------------------------------
barcode1:
' 変更前はここでSet MiBar = New Mibarcd.Autoしていた
MiBar.CodeType = 2 '2:code39,12:QR2コード
'基本オプションを設定
MiBar.Show (0) 'ウィンドウを隠す
' MiBar.CodeType = 2 '2:code39,12:QR2コード
'バーコード文字列の表示(0=非表示,1=表示)
MiBar.AddCodeChar = 1
'サイズ(倍率)2倍
MiBar.BarScale = 1
'バーコードの高さ
MiBar.Height = 60
'上下マージン
MiBar.HMargin = 5
'左右マージン
MiBar.VMargin = 5
'エラーレベル
MiBar.QRErrLevel = 3
'チェックデジットあり
MiBar.CheckDigit = 0
Code = ""
'データを取得
Code = dncd(Count1)
'コードをセット
MiBar.Code = Code
'バーコードを作成
MiBar.Execute
'カーソルをセットする処理
Cells((mai) * 14 + 13, 1).Activate
'カーソル位置に貼り付け
ActiveCell.PasteSpecial
’変更前はここで Set MiBar = Nothingしていた。
Return
end01tag:
End Sub
>おまけ。シートのオブジェクトと変数をクリア、contentsをすべてクリア開いた後、別のシートの枠を貼り付ける。
Sub CLEARDATA()
Application.DisplayAlerts = False
Worksheets("納品書").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Select
Selection.ClearContents
'図形削除
If ActiveSheet.Shapes.Count > 0 Then
Set 対象シート = ActiveSheet 'オブジェクトへの参照を変数に代入する
対象シート.Shapes.SelectAll 'すべての図形を選択する
Selection.Delete
End If
Worksheets("雛形").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Copy
Worksheets("納品書").Activate
For start1 = 0 To 8
Cells(start1 * 42 + 1, 1).Activate
ActiveSheet.Paste
Next start1
Application.DisplayAlerts = True
End Sub
レコードを読むたびに
Set MiBar = New Mibarcd.Auto
set MiiBar=nothingしていたら
アクティブXコンポーネントはオブジェクトを作成できません
というエラーが、何レコード目かで出る現象が発生。
何レコード目で出るかは不定、また、pcによってエラーが出たり出なかったりした。
このエラーが出る前兆は30秒ほど固また後、上記エラーが出る。
デバッグからvbe(エディター画面)にいってf5を押すと再開される
変更後
バーコード表示用のレコードを読む先頭でSet MiBar = New Mibarcd.Autoを入れて
読み込み終了でset MiiBar=nothingしていたら、処理も早くなってこけなくなった
変更後のサンプルコード
worksheets("納品書").Activate
mai = 0
'レコードを読む前にセット
'Mibarcodeのオートメーションサーバオブジェクトを作成
Set MiBar = New Mibarcd.Auto
x = 0
For Count1 = 0 To co - 1
'レコードを読み込んで納品書シートに書き込み+バーコード作成
GoSub meisub
Next Count1
'印刷範囲を設定する
GoSub prtara
’終了したときオブジェクト破棄
Set MiBar = Nothing
Exit Sub
meisub:
’あらかじめ前のスクリプトで、配列変数にレコード一式読み込んでます。
newdt = ndt(Count1)
newfct = fct(Count1)
newdn = dncd(Count1)
newfct = fct(Count1)
'日付と受け入れ先が変わったら次の伝票へ。日付と受け入れ先が変わるとバーコード変数も変わるようにあらかじめデータをセットしています。
If olddt <> newdt Or x = 6 Or oldfct <> newfct Or olddn <> newdn _
Or oldfct <> newfct Then
'変わったら伝票にバーコードを入れる
GoSub breaksub
End If
'伝票の明細部分の書き出し
Cells((mai - 1) * 14 + x + 5, 1) = hncd(Count1)
Cells((mai - 1) * 14 + x + 5, 2) = hnnm(Count1)
Cells((mai - 1) * 14 + x + 5, 3) = sury(Count1)
Cells((mai - 1) * 14 + x + 5, 4) = tani(Count1)
'Cells((mai - 1) * 14 + x + 5, 5) = tnka(count1)
olddt = newdt
oldfct = newfct
olddn = newdn
oldfct = newfct
x = x + 1
Return
breaksub:
'伝票のヘッダ部分の書き出し
Cells((mai) * 14 + 2, 7) = dncd(Count1)
Cells((mai) * 14 + 12, 2) = hdt(Count1)
Cells((mai) * 14 + 3, 6) = tknm1(Count1)
Cells((mai) * 14 + 4, 7) = tkcd1(Count1)
Cells((mai) * 14 + 4, 2) = ndt(Count1)
Cells((mai) * 14 + 4, 5) = fct(Count1)
' ymdh=date(year(hdt(count1),"0000"),month(hdt(count1),"00"),day(hdt(count1),"00"))
'バーコード作成
GoSub barcode1
x = 1
mai = mai + 1
Return
prtara:
Worksheets("納品書").Activate
prtendr = (mai - 1) * 14 + 14
rangestr = Range(Cells(1, 1), Cells(prtendr, 7)).Address(ReferenceStyle:=xlA1)
ActiveSheet.PageSetup.PrintArea = rangestr
Return
'------------------------------------------------------------------------
barcode1:
' 変更前はここでSet MiBar = New Mibarcd.Autoしていた
MiBar.CodeType = 2 '2:code39,12:QR2コード
'基本オプションを設定
MiBar.Show (0) 'ウィンドウを隠す
' MiBar.CodeType = 2 '2:code39,12:QR2コード
'バーコード文字列の表示(0=非表示,1=表示)
MiBar.AddCodeChar = 1
'サイズ(倍率)2倍
MiBar.BarScale = 1
'バーコードの高さ
MiBar.Height = 60
'上下マージン
MiBar.HMargin = 5
'左右マージン
MiBar.VMargin = 5
'エラーレベル
MiBar.QRErrLevel = 3
'チェックデジットあり
MiBar.CheckDigit = 0
Code = ""
'データを取得
Code = dncd(Count1)
'コードをセット
MiBar.Code = Code
'バーコードを作成
MiBar.Execute
'カーソルをセットする処理
Cells((mai) * 14 + 13, 1).Activate
'カーソル位置に貼り付け
ActiveCell.PasteSpecial
’変更前はここで Set MiBar = Nothingしていた。
Return
end01tag:
End Sub
>おまけ。シートのオブジェクトと変数をクリア、contentsをすべてクリア開いた後、別のシートの枠を貼り付ける。
Sub CLEARDATA()
Application.DisplayAlerts = False
Worksheets("納品書").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Select
Selection.ClearContents
'図形削除
If ActiveSheet.Shapes.Count > 0 Then
Set 対象シート = ActiveSheet 'オブジェクトへの参照を変数に代入する
対象シート.Shapes.SelectAll 'すべての図形を選択する
Selection.Delete
End If
Worksheets("雛形").Activate
endr = Cells(1, 8).End(xlDown).Row
Range(Rows(1), Rows(endr)).Copy
Worksheets("納品書").Activate
For start1 = 0 To 8
Cells(start1 * 42 + 1, 1).Activate
ActiveSheet.Paste
Next start1
Application.DisplayAlerts = True
End Sub
2012年10月27日土曜日
sqlserver2008のピボットテーブルの更新をすると、「データソース名および指定された既定のドライバが見つかりません」となる
現象
sqlserver2008のピボットテーブルをエクセルで作って、他のpcに配布して実行すると、
「データソース名および指定された既定のドライバが見つかりません」とエラーになって
データが取り出せない
原因
その端末に、SQL Server Native Client がインストールされていない
処置
①SQL Server Native Client をインストールする
microsoft download centerで検索語、"Microsoft SQL Server 2008 用 Feature Pack"で出てきます
sqlserver2008で検索しても出てこないのが謎です
①の通りにするとインストールできます
端末ごとにクライアントをインストールしなきゃいけないなんて面倒だな、
なんか、他にいい方法があるかもしれないけど、動いたからいいか。。
やってダメだったこと
動作するpcからodc記述を動かないpcにコピーしたがダメだった。
sqlserver2008のピボットテーブルをエクセルで作って、他のpcに配布して実行すると、
「データソース名および指定された既定のドライバが見つかりません」とエラーになって
データが取り出せない
原因その端末に、SQL Server Native Client がインストールされていない
処置
①SQL Server Native Client をインストールする
microsoft download centerで検索語、"Microsoft SQL Server 2008 用 Feature Pack"で出てきます
sqlserver2008で検索しても出てこないのが謎です
①の通りにするとインストールできます
端末ごとにクライアントをインストールしなきゃいけないなんて面倒だな、
なんか、他にいい方法があるかもしれないけど、動いたからいいか。。
やってダメだったこと
動作するpcからodc記述を動かないpcにコピーしたがダメだった。
2012年10月1日月曜日
mibarcode.exeを立ち上げると、「システムリソースが足りません」とでる
Mibarcd.iniを削除したら出なくなりました。
Mibarcd.iniは、Mibarcd.exeを立ち上げると自動で作られます
Mibarcd.exeを違うフォルダに移すと正常に立ち上がるようになることから気づきました。
正常なiniファイルと比べてみるとfontsizeが異常なのが分かる
vbaで連続でバーコードを走らせてなぜかexitが効かずに止まる場合に発生(再現100%)
手動でf8でスキップさせると発生しない
なぜだー
注意↓複数回走らせると、cpu100%になって動かなくなります。ctrl+atl+delでタスクマネージャーを立ち上げログオフするしか手がなくなります。タスクマネージャーのプロセスタブに、mibarcd.exeがたくさん貯まった状態になります。 プロセスが終了するまで待つプログラムを検討中です。。
少数のレコードで試すとmibarcd.exeがタスクマネージャーに溜まったのが見れます。
>プログラム1 順番が前後しますが、何を走らせてそうなったか
Sub MiBarCall()
Dim Temp
Dim Code
'データを取得
Set Code = Range("A1")
'/HTxxx バーコードの高さ。xxxに高さを指定。(例:/HT80)
'/LMxxx バーコードの両脇マージン。xxxにマージン指定。(例:/LM15)
'/TMxxx バーコードの上下マージン。xxxにマージン指定。(例:/TM10)
'/ITF ITFコードを使用します。
'/TN2 サイズ2倍
'/BC0 ITFコードの外枠なし。
Worksheets("sheet1").Activate
For i = 1 To 1
Code = "A00001"
Temp = Shell("C:\temp\Mibarcd.exe /S /HT60 /LM20 /TM10 /C39 /TN1 /cd0 /cc1 " + Trim(Code), 1)
Cells(i, 1).PasteSpecial
Temp = Shell("c:\temp\MiBarcd.exe /EXIT", 0)
Next i
End Sub
原因を推測するに、バーコード表示が起動している最中に、exitが走って無視されてしまうんでしょうね
Mibarcd.iniは、Mibarcd.exeを立ち上げると自動で作られます
Mibarcd.exeを違うフォルダに移すと正常に立ち上がるようになることから気づきました。
正常なiniファイルと比べてみるとfontsizeが異常なのが分かる
| ダメなiniファイル | 正常なiniファイル |
| [Options] | [Options] |
| TaskTary=0 | TaskTary=0 |
| CodeType=2 | CodeType=1 |
| ThinWidth=0 | ThinWidth=0 |
| CheckDigit=0 | CheckDigit=0 |
| AddCodeChar=1 | AddCodeChar=0 |
| FormType=1 | FormType=1 |
| FormStyle=1 | FormStyle=0 |
| AutoCopy=1 | AutoCopy=0 |
| CopyToMf=0 | CopyToMf=0 |
| CopyToEMf=1 | CopyToEMf=1 |
| CopyToBm=0 | CopyToBm=0 |
| CBWatch=0 | CBWatch=0 |
| BarHeight=60 | BarHeight=50 |
| LeftMargin=20 | LeftMargin=20 |
| TopMargin=10 | TopMargin=5 |
| Font.Name=MS UI Gothic | Font.Name=Tahoma |
| Font.Size=-8733 | Font.Size=8 |
| Font.Style=49 | Font.Style=0 |
| Font.Color=0x006F0047 | Font.Color=0xFF000008 |
| BoxDraw=0 | BoxDraw=0 |
| Comment=0 | Comment=0 |
| ComntPos=1 | ComntPos=1 |
| ComntAl=1 | ComntAl=1 |
| ComntStr= | ComntStr= |
| QRVersion=4 | QRVersion=4 |
| QRErrLebel=0 | QRErrLebel=0 |
| Trim_Space=0 | Trim_Space=0 |
| PasteErr=0 | PasteErr=0 |
| [Desktop] | [Desktop] |
| Windows.Flags=0 | Windows.Flags=0 |
| Windows.Show=1 | Windows.Show=1 |
| Windows.MaxX=-1 | Windows.MaxX=-1 |
| Windows.MaxY=-1 | Windows.MaxY=-1 |
| Windows.X=176 | Windows.X=154 |
| Windows.Y=232 | Windows.Y=203 |
| Windows.XSize=533 | Windows.XSize=511 |
| Windows.YSize=599 | Windows.YSize=570 |
| LastStr="/EXIT" | LastStr="" |
| [History] | [History] |
| Count=-1 | Count=-1 |
vbaで連続でバーコードを走らせてなぜかexitが効かずに止まる場合に発生(再現100%)
手動でf8でスキップさせると発生しない
なぜだー
注意↓複数回走らせると、cpu100%になって動かなくなります。ctrl+atl+delでタスクマネージャーを立ち上げログオフするしか手がなくなります。タスクマネージャーのプロセスタブに、mibarcd.exeがたくさん貯まった状態になります。 プロセスが終了するまで待つプログラムを検討中です。。
少数のレコードで試すとmibarcd.exeがタスクマネージャーに溜まったのが見れます。
>プログラム1 順番が前後しますが、何を走らせてそうなったか
Sub MiBarCall()
Dim Temp
Dim Code
'データを取得
Set Code = Range("A1")
'/HTxxx バーコードの高さ。xxxに高さを指定。(例:/HT80)
'/LMxxx バーコードの両脇マージン。xxxにマージン指定。(例:/LM15)
'/TMxxx バーコードの上下マージン。xxxにマージン指定。(例:/TM10)
'/ITF ITFコードを使用します。
'/TN2 サイズ2倍
'/BC0 ITFコードの外枠なし。
Worksheets("sheet1").Activate
For i = 1 To 1
Code = "A00001"
Temp = Shell("C:\temp\Mibarcd.exe /S /HT60 /LM20 /TM10 /C39 /TN1 /cd0 /cc1 " + Trim(Code), 1)
Cells(i, 1).PasteSpecial
Temp = Shell("c:\temp\MiBarcd.exe /EXIT", 0)
Next i
End Sub
原因を推測するに、バーコード表示が起動している最中に、exitが走って無視されてしまうんでしょうね
登録:
投稿 (Atom)

