こんちのまったり

アクセスのコピペ用ページなのです。

　　★データコピー　。DoCmd.OutputTo acOutputQueryを使用して、約47000件のdataをExcelへ出力しようとしましたが「実行時エラー"2306"　出力する行が多すぎて、指定した形式またはMicrosoftAccessの制限を越えています」とメッセージが表示され変換できません。

以下のコードで問題なくExcelに出力できていますが・・・
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "テーブル1", 出力ファイル名, True
最後の引数Trueを付けると、項目名も出力します。
　
　　★オートナンバーリセット(最初に開くフォームを開くイベント）
Sub Test()
　　　 CurrentProject.Connection.Execute _
　　　　　 CommandText:="Alter Table テーブル名 " _
　　　　　　　　　　　 & "Alter Column フィールド名 Identity( 1, 1 );"
　 End Sub
　　★パーセンテージ区切り
式1: IIf([jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.05,"00～05%",IIf([jyutyu_t]![売り上げ順位]>[max]![会員c]*0.05 And [jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.1,"06～10%",IIf([jyutyu_t]![売り上げ順位]>[max]![会員c]*0.1 And [jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.15,"11～15%",IIf([jyutyu_t]![売り上げ順位]>[max]![会員c]*0.15 And [jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.2,"16～20%",IIf([jyutyu_t]![売り上げ順位]>[max]![会員c]*0.2 And [jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.25,"21～25%",IIf([jyutyu_t]![売り上げ順位]>[max]![会員c]*0.25 And [jyutyu_t]![売り上げ順位]<=[max]![会員c]*0.3,"26～30%","31%以上"))))))

　　★yyyymmdd数値～年代抽出　0なら0 nullなら0付き

式6: IIf(IIf(Int((Format(Now(),"yyyy")-Int([テーブル4]![フィールド1]/10000))/10)*10=2000,0,Int((Format(Now(),"yyyy")-Int([テーブル4]![フィールド1]/10000))/10)*10) Is Null,0,IIf(Int((Format(Now(),"yyyy")-Int([テーブル4]![フィールド1]/10000))/10)*10=2000,0,Int((Format(Now(),"yyyy")-Int([テーブル4]![フィールド1]/10000))/10)*10))

★winfaqより

IE で「プロキシを使う」のチェックが解除されてしまいます

Lotus Notes クライアントの現在使用していロケーション文書で、インターネットブラウザとして Internet Explorer を使う設定になっていると、IE のプロキシ設定が Notes のプロキシ設定で上書きされることがあります。
Notes の個人アドレス帳にある通常使用するロケーション文書を編集し、IE と同じプロクシを設定するか、インターネットブラウザとして Netscape Navigator などを指定して下さい。

★エクセル編集　リネームモジュール

標準モジュールにauto()でつくり　マクロでプロシージャ実行

Function auto()
Dim XL As Excel.Application
Dim XLWB As Excel.Workbook
Dim XLWB2 As Excel.Workbook
Dim ST As Variant
Dim EN As Variant
Dim day1 As Variant

Set XL = CreateObject("Excel.Application")
Set XLWB = XL.Workbooks.Open("C:\Documents and Settings\Administrator\My Documents\testt.xls")

XL.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
XL.UserControl = True

Set ST = Form_フォーム1.テキスト3
Set EN = Form_フォーム1.テキスト5
Set day1 = Form_フォーム1.テキスト11

Columns("A:C").Select '集計範囲指定
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Columns("C:C").Select
Selection.NumberFormatLocal = "0_ ;[赤]-0 " 'フォント変更列指定
Rows("1:1").Select
Selection.Insert Shift:=xlDown '行追加
Range("B1").Select
ActiveCell.FormulaR1C1 = "1ヶ月フォローリスト" & ST & "～" & EN & "加入者" '見出し追加
ActiveCell.Characters(3, 1).PhoneticCharacters = "ゲツ"

Range("D1").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[999]C)&""人""" 'カウント関数追加
With Selection 'プロパティ変更
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select 'プロパティ変更
With Selection.Font
.Name = "ＭＳＰゴシック"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("B2").Select

ActiveWorkbook.SaveAs filename:="1mf.xls" 'マイドキュメントに一時保存

ActiveWorkbook.Close 'アクティブシートを閉じる

Set XLWB2 = XL.Workbooks.Open("C:\Documents and Settings\Administrator\My Documents\testt2.xls") '次のファイルを開く
XL.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
XL.UserControl = True

Set ST = Form_フォーム1.テキスト3
Set EN = Form_フォーム1.テキスト5
Set day1 = Form_フォーム1.テキスト11

Columns("A:C").Select '集計範囲指定
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, 3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Columns("C:C").Select
Selection.NumberFormatLocal = "0_ ;[赤]-0 " 'フォント変更列指定
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("B1").Select
ActiveCell.FormulaR1C1 = "1ヶ月フォローリスト" & ST & "～" & EN & "加入者"
ActiveCell.Characters(3, 1).PhoneticCharacters = "ゲツ"

Range("D1").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[999]C)&""人"""
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
With Selection.Font
.Name = "ＭＳＰゴシック"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("B2").Select

ActiveWorkbook.SaveAs filename:="1mf2.xls"

ActiveWorkbook.Close

XL.Quit 'エクセル終了

Set XL = Nothing '開放 '
Set XLWB = Nothing '開放
Name "C:\Documents and Settings\Administrator\My Documents\1mf.xls" As "C:\" & "１ヶ月フォロー" & day1 & ".xls" 'マイドキュのファイルをリネームして　目的に保存
Kill "C:\Documents and Settings\Administrator\My Documents\testt.xls" 'accessで生成するフォルダとファイル（一時保存削除）
Name "C:\Documents and Settings\Administrator\My Documents\1mf2.xls" As "C:\" & "１ヶ月フォロー222" & day1 & ".xls"
Kill "C:\Documents and Settings\Administrator\My Documents\testt2.xls"
DoCmd.Quit

End Function

★日付→企画回のもと

１．weekday(#2005/12/20#) -->3（火曜日）
'２．weekday(#2005/12/1#) -->5（木曜日）
'３．日付の補正　20＋5－1＝24（日付+上行２．の値-日曜日の値）
'４．24÷7＝3　...3
'５．3+1＝4（週目）

★今年だけしのぐ式

=IIf(Month(Format("2006/04/02","yyyy/mm/dd"))<4,DatePart("ww",Format("2006/04/02","yyyy/mm/dd"))+44,DatePart("ww",Format("2006/04/02","yyyy/mm/dd"))-13)
★変則には対応してないけどずっと使える関数

ユーザー関数を組んでみました。
日付はyyyy/mm/ddで渡してください。

日付がyyyymmddとなっている場合は 
 週目: myDatePart(Format(日付,"@@@@/@@/@@"))

基準の月、及び基準の曜日を変える場合は第２、第３引数を変更。
省略した場合は、４月、水曜日。

5月の第一金曜日をStartとする場合。
    ?myDatePart(#2006/8/1#, 5, 6)

＃ヒントを下さった水上さんに感謝。

Function myDatePart(cDay, _
                    Optional sMonth As Integer = 4, _
                    Optional sWDay As Integer = 4) As Integer    '第２、第３引数省略の場合は
                                                                 '４月の第一水曜を基準とする。
  If IsDate(cDay) = False Then Exit Function
     Dim i As Integer
     Dim sDay As Date

   sDay = DateSerial(Year(cDay),sMonth,1)                        '計算日と同年の基準月１日を基準日とする

      i = (Month(cDay) = Month(sDay)) And _
          (Day(cDay) < 7) And _
          (Weekday(cDay) > sWDay)                                '計算日が基準月と同月で第一曜日以前の場合
                                                                 ' i は - 1

   sDay = DateAdd("yyyy", (Month(cDay) < Month(sDay)) + i, sDay) '計算日が基準月以前、または第一曜日以前の
                                                                 '場合は前年を基準月とする。

     For i = 1 To 7                                              '第一曜日となる基準日を求める             
         If Weekday(sDay) = sWDay Then Exit For
         sDay = DateAdd("d", 1, sDay)           
        Next

  myDatePart = DateDiff("ww", sDay, cDay) + 1                    '基準日から計算日までの週数 + 1

 End Function


★入社月シフト計算修正のもと

　IIf(DateDiff("y","2005/01/16",[テーブル1]![フィールド1])<0,-DateDiff("y","2005/01/16",[テーブル1]![フィールド1]),"そのまま")

★入社月シフト計算修正　完成
　
　IIf(DateDiff("y",[入社日],[Forms]![フォーム1]![翌月初日])>0 And DateDiff("y",[入社日],[Forms]![フォーム1]![翌月初日])
　　<[Forms]![フォーム1]![今月日数],DateDiff("y",[入社日],[Forms]![フォーム1]![翌月初日])-出勤日,[Forms]![フォーム1]![今月日数]-出勤日)

最終更新日 2006年9月10日 (日) 1:02 推奨IE5以上解像度1280×1024

このページを快適にご覧いただくには、flashplayerが必要です。

livedoor | yahoo | google | こんちのまったり |

access memo

Section Links

ためになったｈｐ紹介

バナー

アクセスのコピペ用ページなのです。

IE で「プロキシを使う」のチェックが解除されてしまいます

ここに家でつくった式をのせて　会社でこぴぺ

最終更新日 2006年9月10日 (日) 1:02 推奨IE5以上解像度1280×1024

このページを快適にご覧いただくには、flashplayerが必要です。

livedoor | yahoo | google | こんちのまったり |

access memo

Section Links

ためになったｈｐ紹介

バナー

アクセスのコピペ用ページなのです。

IE で「プロキシを使う」のチェックが解除されてしまいます

ここに家でつくった式をのせて 会社でこぴぺ

　　　　　　　　最終更新日 2006年9月10日 (日) 1:02 推奨IE5以上解像度1280×1024

livedoor | yahoo | google | こんちのまったり | 　　

ここに家でつくった式をのせて　会社でこぴぺ