＜Excelのマクロ付きフォーマットを壊されないように＞
こんにちは、 三流プログラマーＫｅｎ３です。 今回は、 Excelのマクロ付きフォーマットを壊されないように を軽く書きたいと思います。 今回の関連画像は、手抜きで無しです（オイオイ）/* * １．今回のキッカケ */
前回の続きなんだけど、 2003/03/18 Access クエリーを Excel既存シートへ エクスポート ( http://www.ken3.org/backno/backno_vba12.html#58 を参照) で、 悪戦苦闘してました。 BBS に以下の投稿がありました。 ( http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi?mode=allread&no=66&page=0 ) >投稿時間：2003/03/19(Wed) 01:38 >投稿者名：TMNOA >タイトル：Re: DoCmd.TransferSpreadsheet acExport でできそうなのですが... > >ＫＥＮ３ 様 > >返信ありがとうございました。 >人生初めてのＢＢＳの使用で少し緊張していたのですが・・・。 > >すみませんが、現状をもう少し説明させてください。 > >１、ＡＣＣＥＳＳのクエリーより（日付・数量）をＥＸＣＥＬにエクスポートしま >す。（既存ブック・新規シート） > >２、既存ブック・新規シートにあるデータを同じ既存ブックの既存シート（カレン >ダー形式の雛形）にＩＦＶＯＯＫＵＰ関数を使用して、転送 > >３、雛形自体をプリントアウトして、データを保存せずにＥＸＣＥＬを閉じる。 > >この状況で、データを保存しないと2番のＩＦＶＯＯＫＵＰ関数の数式が壊れてしま >い2回目以降使用できません。 > >そこで昨日お話させていただいたのですが、アクセス・クエリーよりエクセルの既存 >ブック・既存シートの雛形（カレンダー雛形）にエクスポートしたいのですが・・・。 > >すみません、お手間を取らせて。 >何か案がありましたら、よろしくお願い致します。 -------------------------------------------------------- と書き込みがありました。 さて、どうしましょう？ なんて言って無いで、 過去の記憶を（経験から）似たような事例を頭に思い浮かべると あっ、あれがいいかなぁと１つ浮かんだので、メルマガに載せます。/* * ２．苦い経験、Excelのマクロ付きフォーマットを壊された */
その昔、ＡｃｃｅｓｓのデータからＥｘｃｅｌの雛形にデータをセットしてました。 私の場合は、関数が壊れたとかじゃなくて、 Excelなので、担当者がいろいろとフォーマットをイジって上書き保存してしまい、 処理が動かなくなったなんてことがありました。 >３、雛形自体をプリントアウトして、データを保存せずにＥＸＣＥＬを閉じる。 > >この状況で、データを保存しないと2番のＩＦＶＯＯＫＵＰ関数の数式が壊れてしま >い2回目以降使用できません。 いつものクセで文章を逆に読むと、(嫌いじゃない＝好き、とは言えないけど何の話？) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ データを保存すると、数式は壊れない？ でも保存すると２回目以降不具合がある？ なんて勝手に想像しました。 私がやってた処理は（対策は）、 Excelの雛形にデータをセット後に、 別名で保存してあとはお好きなように的な処理にしました。 なんて書いても？なので、実際の処理を載せます。 ファイルの構成 (V:が共有ネットワークドライブです) C:\MDB\別荘管理.mdb V:\DATA\MAKE_水道台帳.xls (これが雛形) V:\DATA\PRINT.CSV (クエリーをＣＳＶにした中間データ) V:\水道台帳.xls (別名にした結果のファイル) ________ 処理概要 ^^^^^^^^ Accessの管理データから抽出された情報をＣＳＶに保存します。 DoCmd.TransferText acExportDelim, "", "Q_CSV_水道台帳", "V:\DATA\PRINT.CSV" ExcelをCreateObject("Excel.Application")で起動 雛形を開く oApp.workbooks.Open "V:\DATA\MAKE_水道台帳.xls" 'フォーマットを開く データセット処理 oApp.Run ("MAIN") 'Excel側のマクロを起動 ここからExcel側で、 Call READ_DATA 'CSVからデータ読みこみ Call MAKE_DATA 'データをセット でポイントが下記の、 'フォーマット破壊防止 and 作業者が使いやすいように共通Ｖ：のルートへ ActiveWorkbook.SaveAs FileName:="V:\水道台帳.xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False と、共通ドライブのルートに別名にして保存しました。 ＊雛形は保存されてないので、２回目の処理も動くし、 作業者がシートをいじっても、大丈夫かなぁ。 _______________________________ Access側の処理 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub B_水道料台帳_Click()
Dim oApp As Object
Dim W_MIDASHI As String
W_MIDASHI = "MIDASHI"
DoCmd.TransferText acExportDelim, "", "Q_CSV_水道台帳", "V:\DATA\PRINT.CSV", True, ""
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
oApp.UserControl = True
oApp.workbooks.Open "V:\DATA\MAKE_水道台帳.xls" 'フォーマットを開く
oApp.sheets("MIDASHI").Cells(1, 1) = Me![SEL_別荘].Column(0)
oApp.sheets("MIDASHI").Cells(2, 1) = Me![SEL_別荘].Column(0)
oApp.Run ("MAIN") 'Excel側のマクロを起動
End Sub |
Sub MAIN()
Application.DisplayAlerts = False
Application.Caption = "水道料入金台帳"
Sheets("HYO").Select
Range("A1").Select
Call READ_DATA
Call MAKE_DATA
'フォーマット破壊防止 and 作業者が使いやすいように共通Ｖ：のルートへ
ActiveWorkbook.SaveAs FileName:="V:\水道台帳.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
MsgBox "データ作成終了、Ｂ５用紙をセット後、印刷してください。"
End Sub |
Sub READ_DATA()
'
' Macro1 Macro
' 記録日 : 1998/2/17
'
Workbooks.Open FileName:="V:\DATA\PRINT.CSV"
Cells.Select
Selection.Copy
Windows("MAKE_水道台帳.xls").Activate
Sheets("DATA").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PRINT.CSV").Activate
Range("A1").Select
ActiveWorkbook.Close
End Sub |
Sub MAKE_DATA()
Dim W_FURIGANA
W_FURIGANA = Left(Sheets("DATA").Cells(2, 8), 1)
Sheets("HYO").Select
Range("A1").Select
'データ数を数える
Y_LINE = 2
While 0 < Len(Sheets("DATA").Cells(Y_LINE, 2))
Y_LINE = Y_LINE + 1
Wend
'コピー先にデータを挿入する
Sheets("HYO").Select
Rows("4:4").Copy
Rows("5:" & LTrim(Str(5 + Y_LINE))).Select
Selection.Insert Shift:=xlDown
'データをセットする
Y_LINE = 2
YY = 4
While 0 < Len(Sheets("DATA").Cells(Y_LINE, 2))
'セットするセルに移動する
Cells(YY, 1).Select
'滞納有無
If Sheets("DATA").Cells(Y_LINE, 12) > 1 Then
Cells(YY, 1) = "滞"
Else
Cells(YY, 1) = " "
End If
'氏名 印刷エリアが小さいので省略形にする。まったく追加処理だよ
W_NAME = Sheets("DATA").Cells(Y_LINE, 3)
W_MAE = Left(W_NAME, 4)
W_ATO = Right(W_NAME, 4)
If W_MAE = "株式会社" Then
W_NAME = "(株)" & Mid(W_NAME, 5, 30)
End If
If W_MAE = "有限会社" Then
W_NAME = "(有)" & Mid(W_NAME, 5, 30)
End If
If W_ATO = "株式会社" Then
W_LEN = InStr(W_NAME, "株式会社")
W_NAME = Mid(W_NAME, 1, W_LEN - 1) & "(株)"
End If
If W_ATO = "有限会社" Then
W_LEN = InStr(W_NAME, "有限会社")
W_NAME = Mid(W_NAME, 1, W_LEN - 1) & "(有)"
End If
Cells(YY, 4) = W_NAME
'改ページのチェック 1998/06/29 追加、グループ化しろって？やんなるね
If W_FURIGANA <> Left(Sheets("DATA").Cells(Y_LINE, 8), 1) Then
W_FURIGANA = Left(Sheets("DATA").Cells(Y_LINE, 8), 1)
KUGIRI = LTrim(Str(YY))
Rows(KUGIRI & ":" & KUGIRI).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
'号地
Cells(YY, 5) = Mid(Sheets("DATA").Cells(Y_LINE, 2), 2, 1)
Cells(YY, 6) = Mid(Sheets("DATA").Cells(Y_LINE, 2), 4, 6)
'地積
Cells(YY, 7) = Sheets("DATA").Cells(Y_LINE, 5)
'建物管理費
W_KAZU = Sheets("DATA").Cells(Y_LINE, 6)
Cells(YY, 8) = Format(Int(W_KAZU / 1000), "##")
If Val(Cells(YY, 8) & "") > 0 Then
Cells(YY, 9) = Format((W_KAZU Mod 1000), "000")
Else
Cells(YY, 9) = Format((W_KAZU Mod 1000), "###")
End If
'他の年度にも同様の数値をセットする
Cells(YY, 11) = Cells(YY, 8)
Cells(YY, 12) = Cells(YY, 9)
Cells(YY, 14) = Cells(YY, 8)
Cells(YY, 15) = Cells(YY, 9)
'カウントアップ
Y_LINE = Y_LINE + 1
YY = YY + 1
Wend
'保存する
Range("A1").Select
'ActiveWorkbook.Save '上のルーチンで別名保存するので
'もうフォーマット壊すなよなぁ
'ＶＢＡいじれる社員が来たらどうしましょう？
'ここみてたら、一緒にがんばろうよ。変更多いよここ。
End Sub |
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]