他のファイル形式で出力する際はちゃんとLoadイベントが発生する。
pdf出力するレポートを作成する際は、Loadイベントを使わないで、Openイベントなどで代替するようにすべし。
Access2010で確認
Sub ShrinkToFit(ctl As Control, ByVal FontSize As Integer) Dim BaseHeight As Integer With CodeContextObject .FontName = ctl.FontName .FontSize = FontSize .FontBold = ctl.FontBold .FontItalic = ctl.FontItalic .FontUnderline = ctl.FontUnderline BaseHeight = .TextHeight(ctl.Value) '文字が切れた場合があったので-50で調整 Do Until .TextWidth(ctl.Value) < (ctl.Width - ctl.LeftMargin - ctl.RightMargin - 50) Or .FontSize = 1 .FontSize = .FontSize - 1 Loop ctl.FontSize = .FontSize ctl.TopMargin = (BaseHeight - .TextHeight(ctl.Value)) \ 2 End With End Sub
Declare Function api_Macro_Close Lib "msaccess.exe " Alias "#20" (ByVal hMacro As Long) As Long
Declare Function api_Macro_NextRow Lib "msaccess.exe" Alias "#22" (ByVal hMacro As Long, ByVal lSkipBlank As Long, lEndOfMacro As Long) As Long
Declare Function api_Macro_SaveActID Lib "msaccess.exe" Alias "#25" (ByVal hMacro As Long, ByVal lActId As Long) As Long
Sub SaveMacro()
Dim hMacro As Long
WizHook.Key = 51488399
'
hMacro = WizHook.OpenScript("エキスポート", "", 2, 0, 0)
If hMacro = 0 Then Exit Sub
'
'1行
api_Macro_NextRow hMacro, 0, 0
'マクロ名(ラベル)
WizHook.SaveScriptString hMacro, 0, "出力"
'条件
WizHook.SaveScriptString hMacro, 2, "MsgBox(""実行しますか?"",17)<>1"
'アクション
api_Macro_SaveActID hMacro, 45 'マクロの中止
'コメント
WizHook.SaveScriptString hMacro, 1, "テーブルをエキスポートする"
'
'2行
api_Macro_NextRow hMacro, 0, 0
'アクション
api_Macro_SaveActID hMacro, 40 '値の設定
'以下アクションのパラメータ
WizHook.SaveScriptString hMacro, 3, "[Forms]![form1]![txtFileName]"
WizHook.SaveScriptString hMacro, 4, """zzz.csv"""
'
'3行
api_Macro_NextRow hMacro, 0, 0
'アクション
api_Macro_SaveActID hMacro, 49 'テキスト変換
'以下アクションのパラメータ
WizHook.SaveScriptString hMacro, 3, "2"
WizHook.SaveScriptString hMacro, 5, "ZAA"
WizHook.SaveScriptString hMacro, 6, "=[Forms]![form1]![txtFileName]"
WizHook.SaveScriptString hMacro, 7, "0"
'コメント
WizHook.SaveScriptString hMacro, 1, "テキストの変換"
'
'4行
api_Macro_NextRow hMacro, 0, 0
'アクション
api_Macro_SaveActID hMacro, 22 'メッセージボックス
'以下アクションのパラメータ
WizHook.SaveScriptString hMacro, 3, "終わった"
WizHook.SaveScriptString hMacro, 4, "-1"
WizHook.SaveScriptString hMacro, 5, "4"
'コメント
WizHook.SaveScriptString hMacro, 1, "しゅうりょう"
'
api_Macro_Close hMacro
End Sub
Declare Function api_Macro_Close Lib "msaccess.exe " Alias "#20" (ByVal hMacro As Long) As Long
Declare Function api_Macro_NextRow Lib "msaccess.exe" Alias "#22" (ByVal hMacro As Long, ByVal lSkipBlank As Long, lEndOfMacro As Long) As Long
Declare Function api_Macro_GetActID Lib "msaccess.exe" Alias "#29" (ByVal hMacro As Long) As Long
Sub ListMacroDetail()
Dim lHdr As Long, sArgs1 As String, lActID As Long, Macro As Variant, i As Long, ret As Long
Dim sArg(5) As String
WizHook.key = 51488399:
For Each Macro In CurrentProject.AllMacros
lHdr = WizHook.OpenScript(Macro.Name, "", 0, 0, 0)
If lHdr Then
Do While api_Macro_NextRow(lHdr, 0, 0)
'マクロ名(オブジェクト)
Debug.Print Macro.Name & ",";
'マクロ名(ラベル)
Call WizHook.GetScriptString(lHdr, 0, sArgs1)
Debug.Print sArgs1 & ",";
'条件式
Call WizHook.GetScriptString(lHdr, 2, sArgs1)
Debug.Print sArgs1 & ",";
'アクション
lActID = api_Macro_GetActID(lHdr)
Debug.Print WizHook.NameFromActid(lActId) & "(" & lActId & "),";
'コメント
Call WizHook.GetScriptString(lHdr, 1, sArgs1)
Debug.Print sArgs1 & ",";
'第1パラメータ
Call WizHook.GetScriptString(lHdr, 3, sArgs1)
Debug.Print sArgs1 & ",";
'第2パラメータ
Call WizHook.GetScriptString(lHdr, 4, sArgs1)
Debug.Print sArgs1 & ",";
'第3パラメータ
Call WizHook.GetScriptString(lHdr, 5, sArgs1)
Debug.Print sArgs1 & ",";
Debug.Print
Loop
api_Macro_Close lHdr
End If
Next
End Sub
'TextBox,ComboBox,CheckBoxに紐付いてるLabelを一覧表示する
Sub ListLabels(ByVal FormName As String, ByVal Delimiter As String)
Dim ctl As Control
DoCmd.OpenForm FormName, acDesign, , , , acHidden
For Each ctl In Forms(FormName).Controls
If TypeOf ctl Is TextBox _
Or TypeOf ctl Is ComboBox _
Or TypeOf ctl Is CheckBox Then
Debug.Print GetLabelCaption(FormName, ctl.name) & Delimiter;
End If
Next
DoCmd.Close acForm, FormName
End Sub
'コントロールに紐付いてるLabelを取得する
Function GetLabelCaption(ByVal FormName As String, ByVal ControlName As String) As String
Dim ctl As Control
For Each ctl In Forms(FormName).Controls
If TypeOf ctl Is Label Then
If ctl.Parent.name = ControlName Then
GetLabelCaption = ctl.Caption
Exit Function
End If
End If
Next
GetLabelCaption = ""
End Function
日 | 月 | 火 | 水 | 木 | 金 | 土 |
---|---|---|---|---|---|---|
1 | 2 | 3 | 4 | 5 | ||
6 | 7 | 8 | 9 | 10 | 11 | 12 |
13 | 14 | 15 | 16 | 17 | 18 | 19 |
20 | 21 | 22 | 23 | 24 | 25 | 26 |
27 | 28 | 29 | 30 | 31 |
この広告は180日以上新しい記事の投稿がないブログに表示されております。