Dim i As Long
For i = 1 to 12
With Me.Controls("txt_" & i & "月")
.Visible = False
If Not IsNull(.Value) Then
Me.FontSize = .FontSize
Me.FontName = .FontName
Me.CurrentX = .Left + 26 '//26は位置調整のための数字
Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
Me.Print .Value
End If
End With
Next
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
With Me.テキストボックス１
.Visible = False
Me.FontSize = .FontSize
Me.FontName = .FontName
Me.CurrentX = .Left
Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
Me.Print .Value
End With
End Sub
【現状のコード】
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
With Me.請受金額月額
.Visible = False
.Format = "Currency"
Me.FontSize = .FontSize
Me.FontName = .FontName
Me.CurrentX = .Left
Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
Me.Print .Value
End With
If IsNull(Me.txt_1月) = False Then
If IsNull(Me.txt_1月) = True Then Me.txt_1月 = Me.txt_1月
With Me.txt_1月
.Visible = False
Me.FontSize = .FontSize
Me.FontName = .FontName
Me.CurrentX = .Left + 26 '//26は位置調整のための数字
Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
Me.Print .Value
End With
End If
End Sub
Dim h As Long
Private Sub Report_Load()
h = Me!Ctl1月.Height
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
Me!Ctl1月.TopMargin = (Me!自社用.Height - h) / 2
End Sub
hは固定値なので直接記述してもいいかなとも思います
例）
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
Me!Ctl1月.TopMargin = (Me!自社用.Height - 270) / 2 '//270は元のMe!Ctl1月.height
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
With Me.テキストボックス１
.Visible = False
Me.FontSize = .FontSize
Me.FontName = .FontName
Me.CurrentX = .Left
Me.CurrentY = (Me.Height / 2) - (Me.TextHeight(.Value) / 2)
Me.Print .Value
End With
End Sub
Option Compare Database
Option Explicit
Const A4Height As Long = 21 * 567 'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
' Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
On Error Resume Next
PageHeight = A4Height - Me.Printer.BottomMargin
PageHeight = PageHeight - Me.Section(acPageFooter).Height
ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定
End Sub
Private Sub Report_Page()
On Error GoTo Err_Report_Page
Dim LineTop As Long, LineLeft As Long, LineWidth As Long, LineBottom As Long, SecHight As Long
Dim i As Integer
With Me
LineTop = .ページヘッダーセクション.Height + .グループヘッダー0.Height
LineLeft = .直線355.Left
LineWidth = .直線372.Width
LineBottom = 21 * 567 - Me.Printer.BottomMargin - Me.Section(acPageFooter).Height
SecHight = Me.詳細.Height
'太線 の太さをここで指定
.DrawWidth = 12
'外枠
Me.Line (LineLeft, LineTop - .直線355.Height)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 3.998) * 567) - 90), , B
Me.Line (LineLeft, ((21 - 0.5 - 3.998) * 567) - 95)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 0.5) * 567) - 300 - .直線385.Height), , B
End With
Exit Sub
Exit_Report_Page:
Exit Sub
Err_Report_Page:
Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page
Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page
End Select
End Sub
Private Sub グループフッター2_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Err_Report_Page
If Me.Top + Me.グループフッター2.Height <= PageHeight Then
Me.NextRecord = False
If FormatCount > 10 Then Me.NextRecord = True
'↑想定外の動作で無限ループになった場合でも、10回で止まる
Else
Cancel = True
End If
Exit Sub
Exit_Report_Page:
Exit Sub
Err_Report_Page:
Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page
Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page
End Select
End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Dim j As Integer
Dim i As Integer
For j = 51 To 57
Me.DrawStyle = 0
Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
Next
For i = 2 To 12
Me.DrawStyle = 2
Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
Next
WordWrapOff Me.NAS用, Me.txtFld1
Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False
If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
h(Me.CurrentRecord) = Me.詳細.Height
Else
Dim exHeight As Long
exHeight = h(Me.CurrentRecord)
'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定
End If
End Sub
Private Sub ビル名ヘッダーセクション_Format(Cancel As Integer, FormatCount As Integer)
If Me.Pages > 0 Then
Me.txtTo = d(Me.Page) & "番"
End If
End Sub
Private Sub ビル名フッターセクション_Format(Cancel As Integer, FormatCount As Integer)
If Me.Pages = 0 Then
d(Me.Page) = Me.番号
End If
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "対象物件がないか、住所が入力されていません"
Cancel = True
MsgBox "NAS用メンテナンス計画表を閉じます。"
End Sub
Private Sub cmdFilter_Click()
Dim strFilter As String
If Me.txtFromDate.Value <> "" Then
strFilter = " And 日付>=#" & Me.txtFromDate.Value & "#"
End If
If Me.txtToDate.Value <> "" Then
strFilter = strFilter & " And 日付<=#" & Me.txtToDate.Value & "#"
End If
If Me.txtPartsNim.Value <> "" Then
strFilter = strFilter & " And 部品番号='" & Me.txtToDate.Value & "'"
End If
strFilter = Mid(strFilter, 6) '先頭の不要な" And "を削除
Me.subForm1.Filter = strFilter
Me.subForm1.FilterOn = strFilter <> ""
Me.subForm2.Filter = strFilter
Me.subForm2.FilterOn = strFilter <> ""
End Sub
Sub kansei2(fn As String)
Dim txt As String
Dim strName(1) As String
With Sheets("sheet1")
strName(0) = WorksheetFunction.TextJoin(",", True, .Cells(1, 1).Resize(, 6))
strName(1) = WorksheetFunction.TextJoin(",", True, .Cells(4, 1).Resize(, 11))
End With
With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn, 1)
txt = .ReadAll
.Close
End With
'Debug.Print strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1)
txt = strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1) & vbCrLf & txt
With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn, 2)
.Write txt
.Close
End With
End Sub
Sub Test()
Call kansei2("C:\Users\tasuk\Desktop\A社保申告\SHFD0006temp - コピー.CSV")
End Sub
Sub kansei()
Dim fn As String, txt As String
Dim strName() As String
ReDim strName(1)
'配列に値を入れる
dat = ""
With Sheets("sheet1")
For i = 1 To 6
dat = dat & .Cells(1, i) & ","
Next
dat = Left(dat, Len(dat) - 1) '最後のカンマを取り除く
strName(0) = dat
dat = ""
For i = 1 To 11
dat = dat & .Cells(4, i) & ","
Next
dat = Left(dat, Len(dat) - 1) '最終のカンマを取り除く
strName(1) = dat
End With
Option Compare Database
Option Explicit
'Dim d As Object ' Dictionary オブジェクト用変数
Const A4Height As Long = 21 * 567 'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
' Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
On Error Resume Next
PageHeight = A4Height - Me.Printer.BottomMargin
PageHeight = PageHeight - Me.Section(acPageFooter).Height
ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Dim j As Integer
Dim i As Integer
For j = 51 To 57
Me.DrawStyle = 0
Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
Next
For i = 2 To 12
Me.DrawStyle = 2
Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
Next
If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
h(Me.CurrentRecord) = Me.詳細.Height
Else
Dim exHeight As Long
exHeight = h(Me.CurrentRecord)
'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定
Option Compare Database
Option Explicit
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
Redim h(1 to Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
h(Me.CurrentRecord) = Me.詳細.Height
Else
Dim exHeight As Long
exHeight = h(Me.CurrentRecord)
'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定
End If
End If
以下の様に修正しました。
通貨型、無事にできました！
ありがとうございます！！
失礼しました。
何かで作業途中になっていました…
不思議な現象ですねぇってことで書式「通貨」に設定したテキストボックスでテストをしてみました
結果
書式「通貨(Currency)」で使われる円記号はUnicodeのA5のようです。PrintメソッドがUnicodeに対応していないので文字化けするとかじゃないですかねぇ
文字コードの変換を入れてあげると円記号が表示できます
縦罫線に関しては前の質問でもページフォーマット時(Report_Page)でやればいいのでは？と回答してますが、うまくいかなかったんでしょうか？
ありがとうございます。
1.の通貨型なのですが
のような設定なのですが（日本円設定です）
になってしまいます。
他に設定しなくてはいけない部分があるのでしょうか？
2.の右揃えは出来ました。
ありがとうございます。
3.のこちらも出来ました。
ありがとうございます。
追加の質問で申し訳ないのですが
4.詳細セクションとグループフッターセクションのつなぎ目の部分で縦の罫線が微妙にずれます（画像の右縦線参照）
左位置は表示されている小数点第3位まで同じです。
しかし、設定上プロパティの左位置に数字を入力しても丸められているのか飛び飛びになるので実際にずれているのかもしれません。
これを画像の左縦線の様にまっすぐあわせるのは難しいのでしょうか？
5.画像の「6」が入力されている行が詳細セクションの（このページでの）最終行でその下がグループフッターセクションで作った空行なのですが、詳細セクションとグループフッターセクションの間に隙間ができてしまいます。
縦線の長さは全て一致して、セクションの高さも最小値（恐らく縦線の長さ+横下線の太さ分）になっていますがそれでも隙間が空きます。
また、縦線だけあえて少し長くしてみると
一番下の空白部分に線がはみ出します（当たり前）
一番下にはみ出さず、セクション間に隙間を作らない方法は何かありませんでしょうか？
尚、補足ですが詳細セクションとグループヘッダーセクションやグループフッターセクションページフッターセクションとの間には太線が引かれているため隙間があるのかもしれませんが隠れてしまい見た目上隙間は無いようになっています。
段々とずれてきてしまいすみません。
あと少しだと思うのですが、もう少しよろしくお願いします。
エラーが出ていたためまだ実行結果を見ていませんでした。
もう一度コピペし直したところエラーは出なくなりました。
あと、読解が間違っていたようです。(2024.1.9)でもpos1=8、pos2=17なのでｌ＝8で条件式に入りますね。
この取得した日付をT_発注書取込の発注日フィールドに書き込む記述は、msgboxのところを書き換えればよいでしょうか？
そのエラーがでるのはどの行ですか。エラーのでる行を提示してください。
こちらで試してみましたが「発注書（2024.1.9）.xlsx」でも問題なく 2024/01/09 という日付が返りますが。
実際に試してみましたか。
ありがとうございます。
命名規則に抵触しているのだろうと探していたのですが「こういう風につけましょう」しか見つけられず、「ダメな理由」を見つけることが出来ずにいたのでとても助かりました。
今あるものを確認して修正します。
こちらのコードを試したところ、Beref引数の型が一致しませんとエラーが出るのですが、どうすればよろしいでしょうか？
また、このコードの読解をしていたところ、８文字かそれ以上でなければ日付かどうか判定する条件式に入らないと思うのですが、ファイル名が発注書（2024.1.9）.xlsxのように８桁ではない場合、どうすればよいでしょうか？
テキストボックス名が、
txt_1月, txt_2月 ・・・・txt_12月
だとして、
Controlsで文字列のテキストボックス名でアクセスできますので、
それを利用してループ処理します。
テキストボックスは非表示にして、Printメソッドで表示してますので、そちらの方を修正する必要があります。
本題から遠いので個別に
ニンゲンが記述するものはすべて「文字」なので、それが計算してほしいモノ（計算式）なのか、名前の指定なのかはそれだけでははっきりとしません
例えば「1 + 1」という名前のテキストボックスを作ったらそれを指定するときはどうしたらいいでしょうか？
ACCESSは開発を楽にするためにある程度自動認識でこれらの判別をしています
Me.1月という記述はその自動認識によって構文エラーとなるような記述ということですねそれがオブジェクトの名前による指定であると明記する場合には
[]で囲みます。Me.[1月]とすれば正常に動作します命名規則（の一部）というやつですが、どんな文字でもいいからと言って本当にどんな名前にしてもいいというわけではないということですね
可能な限り数字や記号から始まる名前を付けるのはやめましょう
適当にサンプルで作ったのはこんな感じですね
オブジェクトの表示にはいろんな「隙間」があるので影響あるものを見つけて適切に調整する必要はあると思います
1.数字を桁区切り＋￥がついた通貨型で表示したい
2.指定した場所から左揃えではなく右揃えで表示したい
3.同じような書式設定にしたいものが複数あるが、同じコードを繰り返す以外のやり方はないのか？
1に関しては
上記のコードだと下記の画像の様に桁区切りも￥もない数字になってしまい、以下を試しました。
.text → SetFocusがレポートの印刷プレビューではできない
.Value → 値を代入できないとエラーが出る
.Format = "Currency" → 何も変化なし
Me.請受金額月額 = Format(Me.請受金額月額, "\#,##0") → エラーで進まない
という感じで、結局希望する「協力会社1回金額」のような表示にはできませんでした。
2に関しては
上記コードだと左揃えだったので
としたらテキストボックスよりもだいぶ右の方に表示されました。
尚、よくわからずに
にしてみましたが、当然エラーでした。
3に関しては
まず、レコードによっては値がNullの場合があるため上記のコードにしています。
テキストを上下中央に配置したいテキストボックスは
テキストが1行のものが15（画像の請求回数・請受金額月額・協力会社1回金額・txt_1月～12月まで）、複数行の可能性があるものが2（協力会社名・作業内容）ありますが、複数行表示の可能性があるものは最悪このままでも、と思っていますが上記のようなコードをあと13書くのはコードがかなり冗長になるので避けたいと思いつつ、いい方法が見つけられませんでした。
（余談ですが、当初テキストボックスの名前が「1月」だったのですが、『Me.1月』にするとエラーになってしまい上記の様に『txt_1月』に変更しました。エラーの理由（規則？）を探しましたが見つけられませんでした）
1～3に関し、どうにかクリアしたいのですがもう少し教えていただけると助かります。（当初の質問とずれて来てすみません、問題があるようでしたら新たなスレッドを立てます）
よろしくお願いします。
色々試したのですがhirotonさまのコード、短くてできればそれにしたかったのですが、真ん中にはなってくれず…
hatenaさまの以下の上下中央（レス番号12）コードを元に上下中央にしたいテキストボックス全てに書く方式になりそうです。
【参考コード】
【現状のコード】
ただ、以下のことが出来ずに半日悩んでいました。
hatenaさま
早速なるアドバイスをいただき、ありがとうございました（深々お辞儀）。
自分が想定していた内容、そのものズバリを解りやすく書いていただき、腑に落ちました。
当人が何故「テーブルのコピー」→「リネーム」を洗い替えできていると認識しているのかは
相変わらずナゾですが（しかも自称SE・・・）、
とりあえず「データベースの最適化/修復」を定期的に行うように何とか説得をして、
業務手順資料も修正してもらうように働きかけをしておきます。
それにしても、自称って困りものですね。。。（何を言っても耳を貸さないので）
まず、データベースのデータの管理方法は、エクセルのブックなどのファイルの管理方法とは異なります。
ブックならディスクからメモリ上に読み込んで、更新後ディスクに上書きします。
つまりディスク上のデータ位置は連続しているし、データの順番も固定されています。
Accessの場合は、テーブルデータの更新、削除、追加した場合、データの連続性、データの並び順は保証されません。
更新した場合同じ位置に上書きされるとは限りません。
削除した場合、実際に削除されるわけではなく削除フラグを立てるだけです。
追加した場合、ファイルの最後に追加されるわけでもありません。
これは大量のデータを扱うデータベースに最適化された設計です。
つまり更新、削除、追加を繰り返すと、データの連続性はなくなり、データの並び順もごちゃごちゃになります。
このままではファイルサイズは肥大して、パフォーマンスも落ちます。
データ破損の危険性も高まります。
この非連続性を解消して、並び順もキーフィールドに合致するようにするのが「データベースの最適化/修復」という処理です。
Accessデータベースにおいて定期的な「データベースの最適化/修復」というのは必須といえます。
「テーブルのコピー」→「リネーム」で解決できる場合もあるかもしれませんが、それでは上記の非連続性は解消されませんので根本的な解決にはならないでしょう。
また、データペースにおいて、リレーションシップが設定されていれば、コピー→リネームの前にリレーションシップの削除、リネーム後にリレーションシップの再設定という作業も必要になり煩雑になります。設定ミスで破損なんてことにもなりかねません。
「データベースの最適化/修復」でやっていることは、元のデータベースファイルからデータをキーフィールドの並び順に読み込んで、新規データベースファイルに書き込むという処理をして、完了後に元のファイルを削除して新規ファイルをリネームするということをしています。つまり「洗い替え」をしているということだと思います。
経験上「データベースの最適化/修復」を定期的にやっていればめったに破損することはないです。
ただ、絶対破損しないということはないし、「データベースの最適化/修復」で修復できない場合もないとは言えないので、定期的にデータベースファイルのバックアップを取るという運用も必須でしょう。
おお！！素晴らしいアイデアですね。
印刷時でも余白は変更できるとは思いもよりませんでした。
表形式のレイアウトで高さを揃えるというのも思いつきませんでした。
これには関しては、
Me.Heightでカレントセクションの印刷時拡張時の高さを取得できます。お二方とも、お返事ありがとうございます。
btn決定 → cbo選択肢_AfterUpdate → cbo選択肢_BeforeUpdate → Form_Close → Form_Load
みたいなのを見ると もやもや するわけですけど、
VBEの「モジュール全体を連続表示」では、
プロシージャが長い、多い状態になるとスクロールしてる場合じゃないですよね。
Word のナビゲーションウィンドウのようなものも無く。
私はひとり情シスですが、詳しいお二方のご意見を伺えてよかったです。
ありがとうございました。
いろいろ試してみました
Formatイベント/Printイベントで出来ること/できないことできないことむずかしいですねぇ「Ctl1月」テキストボックスは「自社用」テキストボックスと同時に選択してレイアウト→表形式にしておきます
hは固定値なので直接記述してもいいかなとも思います例）
Printイベントでは多くのプロパティが変更できませんそんな中でも余白のプロパティは変更できるようです
高さのプロパティは変更できないので、印刷時拡張が設定されたテキストボックスと表形式のレイアウトを組んでおくことで高さが揃うようにします
印刷時拡張後の高さは印刷時拡張プロパティを「はい」にしたコントロールから取得できます（詳細セクションの高さでは取得できませんでした）
読み込み時のはエラーが出る原因の話だけですね、>> 11でhatenaさんにも補足していただいていますが
だけで済むので簡単です。（デフォルトでは存在しないレポートヘッダーの組み込みも不要です）
やりとりを軽く眺めていましたが、そもそも「フォーマット時に
Me.詳細.Heightがうまく取得できない問題」が問題なのに、hatenaさんのコードもフォーマット時でMe.詳細.Heightを使っているのでうまくいかないんじゃないかなーって思ってたのでその通りになったなーって印象です下記はテキストボックス１のテキストを上下中央に表示します。
Report_Loadならレポートヘッダがなくても動作するのでそれがいいですね。
上下中央に配置するテキストが画像のように金額だったり、「〇」だけなら、
印刷時イベントでPrintメソッドで出力する方法がいいですね。
これなら配列に高さを格納するコードは不要です。
Report.Print メソッド (Access) | Microsoft Learn
印刷時拡張で2行以上になる場合とかは使えないですし、ユニコード非対応なのでS-Shiftにない文字があると文字化けするのでその場合は、使えませんが。
私もhirotonさんと同じですね。
「必要なモノを適切な名前で、適切なモジュール内に記述」
この一言で言いつくされていると思います。
大きなプロジェクトだとプロシージャだけで百をこえることは普通ですし、追加、修正のたびにどのような順が適切かなんて考えてないです。
いかに適切な名前をつけるかに集中ですね。
ありがとうございます！
コードは書かれていたのですが、まさに
＞レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に[イベント プロシージャ]が設定されていないとか？
これでした！
コードに書いたらそこに記載されると思い込んでいました。失礼しました…
これで無事表示できるようになりました。
しかし、やっぱり元々希望している
【行の高さに係わらず、上下中央にテキストを配置】
ができません…（画像参照）
なお、hirotonさまの仰る
＞ちょっと試してみましたがReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね
も、hatenaさまの仰るレポートヘッダーのフォーマット時もどちらも試しましたが結果は同じでした。
レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に
[イベント プロシージャ]が設定されていないとか？ちょっと試してみましたが
ReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね今は「一切気にしない」ですね
（プロシージャの）順番に意味を持たせることがナンセンスだと思っています
ACCESSオブジェクト上からなら
[イベント プロシージャ]なら「...」で、ユーザー定義関数なら関数名で検索。VBE上なら右クリックのポップアップメニュー内「定義」「元の位置へ移動」コマンドソートした順番で探したいのであれば上部のコンボボックスから
「記述」時点で後々それが重要になるということはまずありません
実際の処理に従って、ということであれば、プロシージャを小分けにした親子関係にしかないモノから、モジュール内で共有の関数、標準モジュールに記述する共通関数等、テキストの記述順で収まるような関係にはならないので、やはりそれを念頭にというのは余計な負荷になります
必要なモノを適切な名前で、適切なモジュール内に記述しておけば、ジャンプ機能でしか参照しないので順番を気にすることはないということですね
やはり同じところで同じエラーが出ます。
何か提示し足りない情報があるということですよね…
コードはこれが全部なので足りないとなると、元になるクエリとかレポートの設定なのでしょうか…
それとももう諦めたほうが良いのでしょうか…
Report_Open時では件数は取得できませんでした。
Report_Open内の下記のコードを削除して、
レポートヘッダーのフォーマット時のイベントプロシージャを下記のように記述してください。
印刷時拡張後のセクションを高さを取得する方法を回答してます。
取得した高さを利用して、ご希望のレイアウトに設定するコードは亞紀姐さんが自分で考えて書いてくださいということです。
ありがとうございます。
返答が遅くなりすみません。
上記のように変更し、以下のコード（全部コピーしました）にしましたが、やはり同じところで止まってしまいます。
（＞しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。）
Me.CurrentRecord にマウスオーバーすると「1」と表示され
Me.詳細.Height にマウスオーバーすると「798」と表示され
h にマウスオーバーすると「h(Me.CurrentRecord) = ＜インデックスが有効範囲にありません＞」と表示されます。
あと、
＞あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。
まずは表示ができるようにと思い、エラーを消したいのですが
まだ誤っている部分があるかを教えていただけると助かります。
尋ねてばかりですみません。
よろしくお願いいたします。
有難うございます。
Me.subForm1.Filter = strFilter
のところでエラーが出たので
Me.subForm1.Form.Filter = strFilter
のように以降4行を変更したら正常に動作することが出来ました。
この度は有難うございました。
それぞれのサブフォームのレコードソースのクエリに抽出条件を設定する方法と、
VBAで抽出条件を生成してサブフォームのFilterプロパティに設定する方法が考えられます。
VBAタグが設定してあるのである程度VBAのスキルをお持ちだと思いますので、VBA利用の方法を提案しておきます。
各コントロールの名前は適当にこちらで決めてますので、実際のものに変更してご利用ください。
CONCAT関数と、TEXTJOIN関数という新参者が現れたのですね。
確かに便利です。
数百程度のセルの処理だったら、いけそうな感じですね。
ありがとうございました。
にしてもです、社保のフォーマットが、所属部分を左端に持ってきていれば、
誰でも簡単素早く電子申請できるのですよ。
ご参考に。
社保のCSVファイルは、列数の異なるデータをひとつのファイルにまとめてあるため、
列数が少ない行には、不要なカンマが入ってしまう事が原因でした。
すべて、配列で読み込むとEXCELは止まってしまうため、
大物の個人データの範囲だけCSVで出力した後に、
データ量が少ない所属データを、先頭に書き込んで上書きすればエラーの出ないファイルができます。
電子申請したい方がいたら、ファイル名だけ変更すればそのまま使えるはずなので、コードをアップしておきます。
Sub kansei()
Dim fn As String, txt As String
Dim strName() As String
ReDim strName(1)
'配列に値を入れる
dat = ""
With Sheets("sheet1")
For i = 1 To 6
dat = dat & .Cells(1, i) & ","
Next
dat = Left(dat, Len(dat) - 1) '最後のカンマを取り除く
strName(0) = dat
dat = ""
For i = 1 To 11
dat = dat & .Cells(4, i) & ","
Next
dat = Left(dat, Len(dat) - 1) '最終のカンマを取り除く
strName(1) = dat
End With
fn = "C:\Users\tasuk\Desktop\A社保申告\SHFD0006temp - コピー.CSV"
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
'Debug.Print strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1)
txt = strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1) & vbCrLf & txt
Open fn For Output As #1
Print #1, txt
Close #1
End Sub
あっ、間違えてますね。
hirotonさん、ご指摘ありがとうござます。
>> 1
じゃないっすかね？
削らないでください。必要です。
それでエラーになるなら、提示のコードが実際のものとは異なっていると思います。
実際のコードをコピーして貼り付けてください。
コードはマークダウンのコードブロックにいれてください。
詳細は下記を参照ください。
Microsoft Access 掲示板 の使い方 Microsoft Access 掲示板 - zawazawa
Me.Recordset.RecordCountはレポートでは使えないようですので、下記に修正してください。まずレポートヘッダーかレポートフッターにテキストボックスを配置して下記のように設定してください。
名前 件数
コントロールソース =Count(*)
可視 いいえ
あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
ありがとうございます。
レポート上には
「=Int(([番号]/6)+0.9) & "頁／" & Int((Count([ビル名])/6)+0.9) & "頁中"」
というテキストボックスがあるのですが、多分それだとうまく作動しないのでは、と思い
「=[Pages]」
という非可視のテキストボックスを作りました。
コードに関しては、現状のコードに追加する形で
Option Compare Database
Option Explicit
'Dim d As Object ' Dictionary オブジェクト用変数
Const A4Height As Long = 21 * 567 'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
' Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
On Error Resume Next
PageHeight = A4Height - Me.Printer.BottomMargin
PageHeight = PageHeight - Me.Section(acPageFooter).Height
ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Dim j As Integer
Dim i As Integer
For j = 51 To 57
Me.DrawStyle = 0
Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
Next
For i = 2 To 12
Me.DrawStyle = 2
Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
Next
WordWrapOff Me.NAS用, Me.txtFld1
Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False
If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
h(Me.CurrentRecord) = Me.詳細.Height
Else
Dim exHeight As Long
exHeight = h(Me.CurrentRecord)
'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定
End If
End Sub
としました。（最後のEnd Ifは対応するIfがない、としてエラーになったため削りました）
しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。
何か他に直さなくてはいけないところがあるのでしょうか？
よろしくお願いします。
フォーマット時イベントで関係する設定を計算してレイアウトを決定します。印刷時イベントでは、それを出力するだけですので、印刷時ではレイアウトは変更できません。
印刷時拡張後の高さは印刷時にしか取得できない、しかし、レイアウト変更は印刷時ではできない、レイアウトの設定には印刷時拡張後の高さが必要である、
ということで普通の方法では不可能な状態です。
そこで利用するのが、下記で紹介している総ページを取得するときのダミーのフォーマット時イベントです。
レポートのイベントの発生メカニズムの研究 その２ - hatena chips
総ページを取得するために最終レコードまでダミーのフォーマット時イベントを発生させる。
その後、先頭に戻って、本番のフォーマット時、印刷時イベントを発生させて実際に出力する。
という動作になってます。
これを利用して、下記のような処理にします。
ダミーのフォーマット時に配列に各行毎の印刷時拡張後の高さを格納しておく。
本番のフォーマット時に配列から印刷時拡張後の高さを取得してそれをもとにレイアウトを設定する。
レポート上のどこでもいいので、総ページ数を取得するためにコントロールソースが
=[Pages]のテキストボックスを配置しておく。(すでに総ページ数を表示するためのテキストボックスがあるなら不要)下記のような感じでレイアウトを設定できます。
とても遅くなったのですが、ようやく方向性が決まり、以下のコードになりました。
検索してくださる方のためにもコードを残します。
ありがとうございました。
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Dim j As Integer
Dim i As Integer
For j = 51 To 57
Me.DrawStyle = 0
Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
Next
For i = 2 To 12
Me.DrawStyle = 2
Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
Next
WordWrapOff Me.自社用, Me.txtFld1
Me.自社用.FELineBreak = False
Me.txtFld1.FELineBreak = False
End Sub