ラベル vba の投稿を表示しています。 すべての投稿を表示
ラベル vba の投稿を表示しています。 すべての投稿を表示

2013年12月20日金曜日

組み込み可能なISAMドライバは見つかりませんでした。

現象
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年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ならコピぺするする感覚でできるのでわかりやすいかなと
残業の人の並びと、グラフの人の並びが同じという前提です。
もともと手で入れていたので、並びも一致させています。

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

2012年10月1日月曜日

mibarcode.exeを立ち上げると、「システムリソースが足りません」とでる

Mibarcd.iniを削除したら出なくなりました。
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が走って無視されてしまうんでしょうね






2011年11月24日木曜日

マクロ を実行できません。このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります。

解決した処置方法
r1c1で始まるマクロ名はクイックアクセスツールバーから走らない。
vbeから動かすと動く
コマンドボタンからは動く
マクロ名をr1c1から始まらない名前にしたら動いた

状況
excelの表示形式 a1とr1c1の切り替えを簡単にしようとして、
pesonal.xlsにr1c1chgというvbaを記述し
クイックアクセスツールバーで登録して呼び出したらエラーで走らなかった
 リボンのマクロから見てみるとr1c1で始まるマクロ名を選択すると「実行」ボタンが淡色になっている
マクロ名をchgr1c1と、r1c1で始まらないファイル名にすると 実行ボタンが押せるようになった
r1c1で始まらないマクロ名でクイックアクセスツールバーに追加したら動くようになった
 メニューバーの上の部分に登録しました

excelのr1c1とアルファベット形式をワンタッチで変えるvba
サンプルコード
Sub chgr1c1()
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
Else
Application.ReferenceStyle = xlA1
End If
End Sub

xlstartにpesonal.xlsを作って呼び出すようにしたけど、excelを開くたびに、pesonal.xlsが開いて気持よくない。。
ただ、r1c1とa1を切り替えることは、結構あるのでこれで使い勝手が良くなった

win7だとC:\Users\(ユーザー名)\AppData\Roaming\Microsoft\Excel\XLSTART
にPERSONAL.XLSBを作り、vbeからこのマクロを追加すると、余計なブックが開かなくていいい。

PERSONAL.XLSBを作りといったが、作っただけで動くかどうか確証がない。
はじめ、personal.xlsbというファイル名でこのコードを入れたものを作ったが、エクセルを開くとき、
「PERSONAL.XLSB を開くことができません。ファイル形式または拡張子が正しくありません。」というメッセージが毎回表示される」というメッセージが表示されるようになってしまった。
okを押して、ファイルーオプションーアドイン-設定でpersonalを追加すれば、エクセル起動時、このコードをクイックアクセスバーに登録して使うことはできた。
できたが、毎回警告が出るので邪魔臭い。
出ないようにするには、マクロ記録から、保存先、個人用マクロブックを選んで保存。
XLSTARTフォルダにPERSONAL.XLSBが作られるので、そこのvbeに上のコードを追加して保存。
という手順で、上記コードを、余計なブックを開かずに実行できるようになった。
リボンから開発タブ-マクロを押したとき出てくるマクロの保存先には、個人用マクロブックは現れない。マクロ記録を押すと、保存先に個人用マクロブックが現れます。
はじめから、 大文字でPERSONAL.XLSBを作ったらいけたのかもしれない。。

2010年10月4日月曜日

この名前は既にあるモジュール、プロジェクト、オブジェクトライブラリで使われています。 vba

EXCEL VBAで他のブックのVBAを参照設定で追加しようとしたとき、上のメッセージが出た
回避方法
F11 VBA EDITOR起動
ツール-VBAProjectのプロパティ
プロジェクト名VBAProjectを変更

2010年2月12日金曜日

要求された操作は実行できません vba

現象
vbaをいじっていて visual basic editorでF8で実行しようとすると
上記のエラーがでて実行できなくなった。原因が特定出きない

処置
excelを終了して再度vbaを走らせたら走りました。

なおらない場合の、別の方法

別のモジュールを挿入して エラーのsub () endsubまでをコピペ
コピー先でf8したら「行ラベルが定義されていません」とうエラーメッセージが表示された
gosub のサブルーチン名のスペルミスでした

これでもエラーになる場合、例えばtestというsubが動かないとすると
sub test1()
test
end sub
みたいに別のところから走らせたら走った
走った後 testを直接f8で走らせたら走った。。

2007年4月23日月曜日

vba 前の実行を待って次を実行するには

Option Explicit 'SampleNo=074 WindowsXP VB6.0(SP5) 2002.05.16
'既存のプロセスオブジェクトのハンドルを取得(P665)
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
'指定のプロセスの終了コードを取得(P660)
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
'開かれているオブジェクトのハンドルを開放する(P1252)
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&

Sub pcom()

Dim IDProcess As Long
Dim hProcess As Long
Dim ExitCode As Long
Dim ret As Long
' プロセスを入れる↓
IDProcess = Shell("notepad.exe")
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, IDProcess)
Do
ret = GetExitCodeProcess(hProcess, ExitCode)
DoEvents
Loop While (ExitCode = STILL_ACTIVE)
ret = CloseHandle(hProcess)

End Sub


'上記を貼り付けるだけ
'動作不具合による責任は負いません

アプリケーション定義またはオブジェクト定義のエラーです

worksheetにvba cells(1,1)などと記述すると出るようです

標準モジュール内で記述するとエラーは起こりません


*多分不正確な記述とは思いますが
上記でエラー回避できます