EXCELVBA
本文へジャンプ  

 

下のエクセルVBAコードは実際に動作しているプログラムから抜き出している。
自分のメモとして作っているので詳しい説明はしていない。
12 印刷枚数が少ない
XPHome、EXCEL2002VBA作品でクライアントさんが印刷実行したら一枚のシート印刷で約100枚のA4印刷が出なくてはならないのに40枚で止まってしまう現象がでた。とりあえず手動でページ指定してなんとかその場は切り抜けた。
止まったときの状況はプリンターには確実に100枚分のデータが送られているが40枚の印刷が完了した時点でキューのデータが消えてしまう。ところがPCを再起動したら別のシート印刷ですが67枚の印刷は問題なく出来ました。
ところが翌日クライアントさんが別のシートを印刷したら67枚しか印刷されないのです。
VBAではカレントセル範囲を印刷範囲に設定しています。
したがってデータ量が変化してもカレントセル範囲はデータ量に比例して変わるので印刷範囲も変化し途中で止まることはないと思うのですが。
いろいろ対策を考えた。
プリンタ自体の不具合、PCの不具合、とかも考えられるのですがVBAの設定の問題かもしれないのでプログラムの最初に
worksheets("TMP").Select
ActiveSheet.PageSetup.PrintArea=""
と入れて見ました。
これによって前回の印刷範囲はクリアされると思うのですが。
結果がどうなるか楽しみです。
ところでこれが有効なら、プログラムの最後にも入れておけば他のプログラムへの影響もなくなるわけです。
(追記)原因がわかった。
プリントエリアの設定に名前付範囲をしていしていたのです。
.Name=CurrentRegion.Addressだったと思う。
これでは失敗です。
PrintArea=""  '----念のため
PrintArea=Selection.Currentregion.Addressとして成功。
11 ラベルキャプションを使った失敗記録
ボタンAとボタンBがあります
ボタンAをクリックするとプログラムXが走り、ユーザID_Aと名前Name_AがDBに入力されます。
ボタンBをクリックしたときにラベルキャプションが1になり、ユーザID_Bと名前Name_Bがセットされます。
ラベルキャプションはデフォルトで0です。

ボタンBをクリックするとプログラムXが走り、ユーザID_Bと名前Name_BがDBに入力されます。

IF文でラベルキャプションを参照しています。

上記のプログラムでときどき入力されるはずのユーザID_Bと名前Name_BがNull値になっていました。
ボタンBを押すことは一年のうち数回なので気がつかなかったのです。何十万件のうちの一件程度でした。

多分ラベルキャプションの変化スピードの問題ではないかと思います。

なにせこのぷrグラムはVBAを始めた初期のころ作ったものでずっと使い続けて来たものです。
ユーザさんにごめんなさい・・です。

じつはこれを見つけたのは年末になってプログラムの移行テストをしている最中でした。
なにもラベルキャプションなど介さなくてもいいのですから。
お正月明けには訂正に走り回るのが仕事始めですね。
10 ExcelVBAと直接関係ないことですがPCの模様替えをしたついでに
Windows2000Sp4環境にOffice2000Developerをインストールした。
そうしたら「MicrosoftOffice2000DeveloperVBAツールをセットアップするにはVisualBasicforApplication6.0が必要です・・・」
というダイアログが表示され、インストールができない現象が出た。
いろいろ調べたらMicrosoftのサポートページ
MicorsoftOffice2000Developer CDのルートにあるacmboot.exeを実行すればよい。
とあってそのとおりに操作したら何の問題もなくインストール出来てしまった。
Developerのサポートはわかりにくい場所にあって困りますね。
9 バックアップソフトNuBak(シェアウエア)をExcelの終了時に起動させてAccessデータのバックアップを取りたい

WorkBook_BeforCloseの中に
 Shell "C:\Program Files\Nubak\Nubak.exe /iNubak_DNS.NBK /min /sa /q",vbNormalFocus

と記述して試したらNubakが起動できました。
"c:\Program ・・・・・”はNubakのPath 
/iNubak_DSN.NBK はNubakの設定ファイル(詳細はNubakのHelp)
/min は最小化起動
/sa はバックアップ設定したものを全部
/q はバックアップを終了したら停止
を指定するオプション

具体例(下記で動作しています)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shell "c:\Program Files\Nubak\Nubak.exe /iNubak_DSN.NBK /Min /sa /q", vbNormalFocus
End Sub


Nubakでなくともいいわけなんですが。
たとえばMYBACKUPなどでも。

もっとかんたんかもしれないのはコピー貼り付けですね。
8 '-----画面の更新をしない、イベントを起こさない
Application.ScreenUpdating = False
Application.EnableEvents = False
7 '-----トップシートのシート名を取得
Application.StatusBar = "データシート名を取得しています"
Worksheets(1).Activate
Dim DataShtName As String
DataShtName = ActiveSheet.Name
6 '----トップシートのデータ範囲アドレスを取得する
Application.StatusBar = "データ範囲番地を取得しています"
Dim DataHani As String
Worksheets(DataShtName).Select
Range("A1").Select
DataHani = Range("A1").CurrentRegion.Address
5 '----リストボックスが選択されているデータについて(リストボックスはマルチセレクト設定)
With ListBox_CNo5
For Selected_Listindex = 0 To .ListCount - 1
If .Selected(Selected_Listindex) = True Then
'-----最初のTrueになったListindexを特定する
Selected_Listindex_Hajime = Selected_Listindex_Hajime + 1

CNo = .List(Selected_Listindex, 2)


End If
4 '-----データシートからTMPシートにデータを抜き出す(使用するときには下記のコードをそのままコピペして””で囲ま'----れた文字列を書き直て使用する。キーボードから入力するとうまくいかないことが多い)

Worksheets(DataShtName).Range(DataHani).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("TMP3").Range("G1:G2"), _
CopytoRange:=Range("A1:BH1"), Unique:=False
3 '-----TMPシートの最下行+1行のアドレスを取得しておく
Worksheets("TMP").Select
Dim SitaAdr As String

If Range("A2") = "" Then
SitaAdr = Range("A1").Address
Else
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
SitaAdr = Selection.Address
End If
2 '-----TMP2シートの表題行を削除しTMPシートの最下行に貼り付ける
Worksheets("TMP2").Activate
If Selected_Listindex_Hajime > 1 Then
Range("A1").EntireRow.Delete Shift:=xlUp
End If
ActiveSheet.UsedRange.Select

Dim DataHani_TMP2 As String
DataHani_TMP2 = Selection.Address

ActiveSheet.Range(DataHani_TMP2).Copy _
Destination:=Worksheets("TMP").Range(SitaAdr)
'-----TMPシートのデータをTMP2シートにコピーする
Worksheets("TMP").Activate
ActiveSheet.Range("A1").CurrentRegion.Select
DataHani = Selection.Address

ActiveSheet.Range(DataHani).Copy _
Destination:=Worksheets("TMP2").Range("A1")
9