目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

┃ ┃一覧表示 ┃ ┃ ┃ ┃

10 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

【108】VBA

手羽先クウ - 05/10/5(水) 21:50 -


	引用なし

	パスワード

VBAというのはマイクロソフトの全てのソフトで利用できますか？
エクセルとかアクセスとかはよく聞きますけど。
どこまで利用できるのか教えてください。

・ツリー全体表示

【107】Re:ｴｸｾﾙの自動でデータを出力

Jaka - 05/9/8(木) 10:26 -


	引用なし

	パスワード

こんにちは。

ここは質問する所ではないので、こちらへどうぞ。
http://www.vbalab.net/vbaqa/c-board.cgi?id=excel

・ツリー全体表示

【106】ｴｸｾﾙの自動でデータを出力

どどど - 05/9/3(土) 13:04 -


	引用なし

	パスワード

ｴｸｾﾙでのデータを毎月、決まった日に自動でそのデータのみを出力ＯＲ抽出？する方法を知りたいのです。

具体的にいうと、毎日変動する数値が10個あります。それは、
Ａ列
12枚
43枚
54枚
22枚
4枚
434枚
45枚
・
・
・
というかんじにあって毎日この数値が変動しているとします。

そして、毎月末のデータを残しておきたいと思いました。
そこで他の列にこのデータを自動で(勝手に)記録される

というかんじのものを作りたいのです。

関数ではないことが分かりました。
マクロではできないものでしょうか？

ぜひ、教えていただきたい。

・ツリー全体表示

【104】Re:ExcelとAccessの日付のシリアル値

WinArrow

- 05/6/20(月) 7:27 -


	引用なし

	パスワード

こんにちは。WinArrowです｡

追加情報です。

Excelでも、VBAでは、Accessと同じになります。

また、1899/12/31以前に生まれた人の年齢もDateDiff関数を使えば、年齢計算可能です。

・ツリー全体表示

【103】ExcelとAccessの日付のシリアル値

WinArrow

- 05/6/20(月) 0:07 -


	引用なし

	パスワード

こんにちは。WinArrowです｡ Excelの「1900年2月29日」の話は、皆さん、ご存知だと思いますが、 Accessでは？と思い、検証してみました。シリアル値 Excel　　 Access 0　　　　1900/1/0　1899/12/30 1　　　　1900/1/1　1899/12/31 2　　　　1900/1/2　1900/1/1 ・　　　　　・　　　　　・・　　　　　・　　　　　・・　　　　　・　　　　　・ 60　　　　1900/2/29　1900/2/28 61　　　　1900/3/1　 1900/3/1 62　　　　1900/3/2　 1900/3/2 　

・ツリー全体表示

【102】日付と期間をオートフィルタで抽出（修正版...

Jaka - 05/5/25(水) 9:04 -


	引用なし

	パスワード

A列に下記のような日付データがあるとして、
Ｃ１に抽出したい西暦年
Ｅ１に抽出したい月
Ｇ１に抽出したい月　　　を記入しこれを参照して抽出します。。
（下記データは、並び替えた方が解りやすいかも）

単にマクロでフィルタをしているだけです。

　A
日付　　　←１行目タイトル
1月15日　　　表示形式は、どれでもいいです。
1月16日
1月17日
1月18日
1月19日
1月20日
2005/2/2
2005/2/3
2005/2/5
2005/2/6
2005/3/3
2005/3/4
2005/5/5
2005/5/6
2005/5/7
2005/8/6
2005/8/7
2005/8/8
2005/10/10
2005/10/12
2005/10/20
2005/11/11
2005/11/23
2005/12/1
2005/12/31
2005/1/30
2005/2/28
2005/10/1
2005/12/12
2004/1/10
2004/2/29
2004/5/31
2004/11/1
2004/12/12
2005/1/10
2005/1/11
2005/1/12
2004/1/1
2004/1/2
2004/1/3
2004/2/2
2004/2/3
2004/2/4
2004/3/3
2004/3/4
2004/3/5
2004/4/4
2004/4/5
2004/4/6
2004/5/25
2004/5/26
2004/5/27

*****************************
Sub 日付でフィルタ()
　　Dim 年 As Integer, 月 As Integer, 日 As Integer, ALast As Long
　　Dim 年月日 As String
　　年 = Range("C1").Value
　　月 = Range("E1").Value
　　日 = Range("G1").Value
　　年月日 = 年 & "/" & 月 & "/" & 日
　　ALast = Range("A65536").End(xlUp).Row
　　If Application.CountIf(Range("A2:A" & ALast), 年月日) = 0 Then
　　　 MsgBox 年月日 & " の物は有りません。"
　　　 Exit Sub
　　End If
　　'１日分の抽出でもxlAndで、２つ指定する。
　　Range("A1:A" & ALast).AutoFilter Field:=1, Criteria1:=">=" & 年月日, _
　　　　　　　　　　　　　Operator:=xlAnd, Criteria2:="<=" & 年月日
　　MsgBox 年月日 & " の物を抽出しました。"
End Sub

*****************************
'ここだけ抽出日を直接コードに書きました。

Sub 期間でフィルタ()
　　Dim 日付1 As String, 日付2 As String
　　日付1 = "2005/2/2"
　　日付2 = "2005/5/6"
　　ALast = Range("A65536").End(xlUp).Row
　　If Application.CountIf(Range("A2:A" & ALast), ">=" & 日付1) - _
　　　 Application.CountIf(Range("A2:A" & ALast), ">" & 日付2) = 0 Then
　　　 MsgBox 日付1 & "～" & 日付2 & " の物は有りません。"
　　　 Exit Sub
　　End If
　　Range("A1:A" & ALast).AutoFilter Field:=1, Criteria1:=">=" & 日付1, _
　　　　　　　　　　　　　Operator:=xlAnd, Criteria2:="<=" & 日付2
　　MsgBox 日付1 & "～" & 日付2 & " の物を抽出しました。"
End Sub

*****************************
'ＩＶ列を作業列に使用。

Sub 月でフィルタ()
　　Dim Strtday As String, Endday As String, ALast As Long
　　Dim 月 As String, Rafi As Range
　　ActiveSheet.AutoFilterMode = False
　　月 = Range("E1").Value
　　ALast = Range("A65536").End(xlUp).Row
　　Range("IV2:IV" & ALast).Formula = "=MONTH(A2)"
　　If Application.CountIf(Columns(256), 月) = 0 Then
　　　 Columns(256).Delete
　　　 MsgBox 月 & "月の物は有りません。"
　　　 Exit Sub
　　End If
　　Range("IV1").Value = "XXX"
　　Range("IV1").AutoFilter Field:=1, Criteria1:=月
　　MsgBox 月 & "月を抽出しました。"
　　Set Rafi = Range("A2:A" & ALast).SpecialCells(xlCellTypeVisible)
　　'ここですぐにIV列をクリアするとフィルタが解除される。
　　Set Rafi = Nothing
　　Columns(256).Delete
End Sub

*****************************
Sub 年月でフィルタ()
　　Dim Strtday As String, Endday As String, ALast As Long
　　Dim 年 As Integer, 月 As Integer
　　ActiveSheet.AutoFilterMode = False
　　'Mth = Application.Match(Range("C1").Value, 0)
　　年 = Range("C1").Value: 月 = Range("E1").Value
　　Strtday = 年 & "/" & 月 & "/1"
　　If IsDate(Strtday) = False Then Exit Sub
　　Endday = 年 & "/" & 月 & "/" & Format(DateSerial(年, 月 + 1, 1) - 1, "d")
　　'Endday = StrConv(Endday, vbNarrow)
　　ALast = Range("A65536").End(xlUp).Row

　　If Application.CountIf(Range("A2:A" & ALast), ">=" & Strtday) - _
　　　 Application.CountIf(Range("A2:A" & ALast), ">" & Endday) = 0 Then
　　　 MsgBox 年 & "/" & 月 & "月の物は有りません。"
　　　 Exit Sub
　　End If

　　Range("A1", Range("A65535").End(xlUp)).AutoFilter Field:=1, Criteria1:=">=" _
　　　　　& Strtday, Operator:=xlAnd, Criteria2:="<=" & Endday
　　MsgBox 年 & "/" & 月 & " を抽出しました。"
End Sub

*****************************
上記コードは、オートフィルタしたままにしてあるので解除する時に使用。

Sub 解除()
　　ActiveSheet.AutoFilterMode = False
End Sub

・ツリー全体表示

【101】bykinさん作「ToolStar」 Ver.4.0.0 配布の...

谷誠之 - 05/5/18(水) 23:21 -

引用なし

パスワード

～添付ファイル～

・名前	： ToolStar.lzh
・サイズ	： 0.6MB

VBA研究所主宰者の谷です。

>このたび、Excel質問箱に時々回答をお寄せくださる bykin さんから、便利な
>アドインを預かりましたのでここで配布いたします。

バージョンアップされたので、お知らせすると共にここに貼っておきます。

新機能は「セル範囲逆転選択」と「最後のセル位置修正」。
主な機能追加は画像変換で行列番号の出力を可能にしたことです。

是非一度お試しください。

・ツリー全体表示

【100】入力規則、条件付書式で、別シートのデータ...

Jaka - 05/5/17(火) 15:32 -


	引用なし

	パスワード

入力規則、条件付書式で、別シートのデータを使用する方法。

入力規則の場合

１、参照させたいセル範囲に名前を付ける方法。
　　例えば
　　A1:A10 を「リスト範囲」と名前を付けたとして
　　入力規則の範囲に
　　= リスト範囲

２、関数で直接指定する場合
　　入力規則の範囲に
　　=INDIRECT("Sheet2!A1:A10")

条件付書式も同じようにできます。

１、参照させたいセル範囲に名前を付ける方法。
　　=COUNTA(リスト範囲)>9

２、関数で直接指定する場合
　　=COUNTA(INDIRECT("Sheet2!A1:A10"))>9

適当な関数にしてありますが、こんな感じで出来ます。

・ツリー全体表示

【99】GetOpenFileNameでブック名もワイルドカード...

りん

- 05/4/23(土) 9:30 -


	引用なし

	パスワード

全て同じモジュールに貼り付けて、Mainを実行。
ワイルドカードやタイトルの指定は全てMainで行い、関数に引数を渡す。

'ここから====
'//API宣言部
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type OPENFILENAME
　 lStructSize As Long
　 hwndOwner As Long
　 hInstance As Long
　 lpstrFilter As String
　 lpstrCustomFilter As Long
　 nMaxCustrFilter As Long
　 nFilterIndex As Long
　 lpstrFile As String
　 nMaxFile As Long
　 lpstrFileTitle As String
　 nMaxFileTitle As Long
　 lpstrInitialDir As String
　 lpstrTitle As String
　 Flags As Long
　 nFileOffset As Integer
　 nFileExtension As Integer
　 lpstrDefExt As String
　 lCustrData As Long
　 lpfnHook As Long
　 lpTemplateName As String
End Type
'//関数
Private Function GetFile(ByVal Filt As String, FiltName As String, MsgTitle As String) As String
　 Dim retc As Long
　 Dim filn As OPENFILENAME
　 Dim Tmpfile As String
　 Dim TmpFileTitle As String
　 Dim fileToOpen As String
　 Dim STIME As Integer
　 '
　 Tmpfile = String(256, 0)
　 TmpFileTitle = String(256, 0)
　 '設定いろいろ
　 With filn
　　　.lStructSize = Len(filn)
　　　.hwndOwner = hWndAccessApp
　　　.hInstance = 0
　　　.lpstrFilter = FiltName & Chr$(0) & Filt & Chr$(0) & Chr$(0)
　　　.lpstrCustomFilter = 0
　　　.nMaxCustrFilter = 0
　　　.nFilterIndex = 0
　　　.lpstrFile = Tmpfile
　　　.nMaxFile = 256
　　　.lpstrFileTitle = TmpFileTitle
　　　.nMaxFileTitle = 511
　　　.lpstrInitialDir = CurDir()
　　　.lpstrTitle = MsgTitle & ":" & Filt & "限定"
　　　.Flags = 0
　　　.nFileOffset = 0
　　　.nFileExtension = 0
　　　.lpstrDefExt = ""
　　　.lCustrData = 0
　　　.lpfnHook = 0
　　　.lpTemplateName = 0
　 End With
　 '
　 retc = GetOpenFileName(filn)
　 fileToOpen = Left(filn.lpstrFile, InStr(filn.lpstrFile, Chr(0)) - 1)
　 If Dir(fileToOpen) <> "" Then
　　　GetFile = fileToOpen
　 Else
　　　GetFile = ""
　 End If
End Function
'//実働部分
Sub MAIN()
　 Dim Filt As String, Ifile As String
　 'ワイルドカード指定
　 Filt = "Book*.xls"
　 Ifile = GetFile(Filt, "読み込みたいファイル", "ファイルを選択してください")
　 '
　 If Ifile = "" Then
　　　MsgBox "CANCEL", vbCritical
　 Else
　　　Workbooks.Open Ifile
　 End If
End Sub
'ここまで====

動作確認 2005/4/23 Win98SE,XL2000

・ツリー全体表示

【98】Spreadsheetコントロール

ichinose - 05/4/22(金) 16:44 -


	引用なし

	パスワード

皆さん、こんにちは。
最近になって、ようやくロ－マ字入力を心がけるように
なったichinoseです
（でも、キーを打つ回数が多いなあ・・。でも、カナだと次にＰＣ使う人には
嫌われてしまうし・・・）。

Excel2000でユーザーフォームにSpreadsheetコントロールを配置したＶＢＡコードが
いくつかあります。これをExcel2002のＳＰ３で起動させたところ
「安全でないActiveXコントロールを初期化しようとしています・・・・」という
警告メッセージが表示されてしまいました。
「はい」をクリックすれば、今までどおりに動きますが、どうもこのメッセージが
邪魔です。どうにかして取りたいのですが・・・。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

１　Windowsのファイル名を指定して実行で「Regedit」を起動します。

２　「KEY_CURRENT_USER」をクリックし、階層をたどっていきます。

３　「HKEY_CURRENT_USER\Software\Microsoft\VBA」までたどります。

４　[VBA] フォルダをクリックし、[編集] メニューの [新規] をポイントして、[キー] をクリックします。

５　 [VBA] フォルダに「New Key ＃1」が追加されたことを確認し、「New Key ＃1」キー名を「Security」に変更します。

６　作成したSecurity キーをクリックし、[編集] メニューの [新規] をポイントして、[DWORD 値] をクリックします。

７　右側の枠で [名前] の項目の一番下に「New Value #1」と表示されましたら、
「New Value #1」キー名を「LoadControlsInForms」に変更します。

８　「LoadControlsInForms」キーをダブルクリックし、
[DWORD 値の編集] ダイアログボックスの [値のデータ] ボックスに
「1」と入力して、[OK] ボタンをクリックします。

９　[レジストリ] メニューをクリックし、
[レジストリエディタの終了] をクリックして、
レジストリエディタを終了します。

上記の操作を実行したところ、警告メッセージが表示されなくなりました。

Win2000で確認。
レジストリーを書き換えていますから、バックアップを行い、
十分注意して確認して下さい。

私は、このSpreadsheetコントロール便利に使わせてもらっているので
ほっとしました。

尚、本家情報は、
http://support.microsoft.com/default.aspx?scid=kb;en-us;827742

です。

・ツリー全体表示

【96】実験

谷誠之

- 05/4/14(木) 23:31 -


	引用なし

	パスワード

これは実験用の書き込みです。

・ツリー全体表示

【95】Re:フォルダの選択

ちゃっぴ - 05/3/19(土) 0:06 -


	引用なし

	パスワード

んでもって本体 '******************************************************************************************* '[BrowseCallbackProc]　　　　　　　　　コールバックされたメッセージによってメッセージを送る '　　　　　　　　　　　　　　　　　　　 (コールバック関数) ' '引数　　　　　　　 hwnd　　　　　　　　[SHBrowseForFolder]ウィンドウハンドル(Long) '　　　　　　　　　 uMsg　　　　　　　　受信メッセージコード(Long) '　　　　　　　　　 lParam　　　　　　　パラメータ値(Long) '　　　　　　　　　 lpData　　　　　　　BROWSEINFO構造体のlParamメンバに設定された値(Long) '******************************************************************************************* Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As BFFM_CallBackMsgCode, _ 　　ByVal lParam As Long, ByVal lpData As Long) As Long 　　　　'メッセージコードが初期化終了の場合　　Select Case uMsg 　　　　Case BFFM_INITIALIZED 　　　　　　'初期フォルダを設定するメッセージ送信　　　　　　Call SendMessage(hwnd, BFFM_SETSELECTIONA, 1, ByVal mstrDefaultPath) 　　　　Case Else 　　End Select End Function '******************************************************************************************* '[FARPROC]　　　　　　　　　　　　　　　AddressOf演算子の戻り値を戻す関数 ' ' 　※　AddressOf演算子の値を変数に直接代入することができないので、 '　　　ダミーとして標準モジュール上に[FARPROC]関数を作成する。 ' '戻り値　　　　　　　　　　　　　　　　対象モジュールのアドレス ' '引数　　　　　　　 pfn　　　　　　　　対象モジュールのアドレス(Long) '******************************************************************************************* Private Function FARPROC(pfn As Long) As Long 　　FARPROC = pfn End Function '******************************************************************************************* '[F_strSHBrowseForFolder]　　　　　　　 BrowseForFolderを表示し、選択されたパス名を返す ' '戻り値　　　　　　　　　　　　　　　　選択フォルダパス名(String) ' '引数　　　　　　　 strDefaultPath　　　初期表示フォルダ(String) '　　　　　　　　　 strPrompt　　　　　表示文字列(String) '　　　　　　　　　 lngFlag　　　　　　 [BROWSEINFO]構造体のulFlag(Long) '　　　　　　　　　 lngpidlRoot　　　　 [BROWSEINFO]構造体のpidlRoot(Long) '　　　　　　　　　 hOwner　　　　　　　親ウィンドウハンドル(Long) '******************************************************************************************* Public Function F_strSHBrowseForFolder( _ 　　Optional ByVal strDefaultPath As String = "", _ 　　Optional ByVal strPrompt As String = "フォルダを選択してください。", _ 　　Optional ByVal lngFlag As BrowseInfoFlags = BIF_RETURNONLYFSDIRS, _ 　　Optional ByVal lngpidlRoot As gEnumCSIDL = CSIDL_DESKTOP, _ 　　Optional ByVal hOwner As Long = -1) As String 　　　　Dim udtBrowseInfo　 As tagBROWSEINFO　　　　　　'[BROWSEINFO]構造体　　Dim lngFolderPID　　As Long　　　　　　　　　　 '選択フォルダPID 　　Dim strFolderPath　 As String * MAX_PATH　　　　'選択フォルダパス名(初期値:vbNullChar * MAX_PATH ) 　　'初期フォルダ指定　　mstrDefaultPath = IIf(strDefaultPath = "", CurDir, strDefaultPath) 　　'[BROWSEINFO]構造体初期化　　With udtBrowseInfo 　　　　'親ウィンドウ設定　　　　.hOwner = IIf(hOwner = -1, FindWindow("XLMAIN", vbNullString), hOwner) 　　　　.pidlRoot = lngpidlRoot　　　　　　　　　　　　 'ルートフォルダ指定　　　　.lpszTitle = strPrompt　　　　　　　　　　　　　'表示文字列指定　　　　.ulFlags = lngFlag　　　　　　　　　　　　　　　'オプションフラグ指定　　　　.lpfn = FARPROC(AddressOf BrowseCallbackProc)　 'コールバック関数のアドレス代入　　End With 　　　　'フォルダ選択ダイアログの表示　　lngFolderPID = SHBrowseForFolder(udtBrowseInfo) 　　　　'選択フォルダのPIDが取得できた場合　　If lngFolderPID <> 0 Then 　　　　'選択フォルダのPIDをパス名に変換　　　　If SHGetPathFromIDList(lngFolderPID, strFolderPath) <> 0 Then 　　　　　　'NULL文字を削除　　　　　　F_strSHBrowseForFolder = _ 　　　　　　　　 Left$(strFolderPath, InStr(strFolderPath, vbNullChar) - 1) 　　　　End If 　　　　'選択フォルダPIDのメモリを開放　　　　Call CoTaskMemFree(lngFolderPID) 　　End If End Function Sub Test() 　　MsgBox F_strSHBrowseForFolder("", , BIF_NEWDIALOGSTYLE Or BIF_NONEWFOLDERBUTTON) End Sub

・ツリー全体表示

【94】Re:フォルダの選択

ちゃっぴ - 05/3/19(土) 0:04 -


	引用なし

	パスワード

SHBrowseForFolderを使用して、Default表示Folderを変更するVersion 長さ制限で引っかかったので･･･宣言部分だけ･･･ '/////////////////////////////////////////////////////////////////////////////////////////// 'モジュール内共通構造体 '/////////////////////////////////////////////////////////////////////////////////////////// '[BROWSEINFO]構造体([SHBrowseForFolder]で使用する構造体) Private Type tagBROWSEINFO 　　hOwner　　　　　As Long　　　　 '親Windowのハンドル　　pidlRoot　　　　As Long　　　　 'ルートフォルダのポインタ(PID) 　　pszDisplayName　As String　　　 '選択されたフォルダ名　　lpszTitle　　　 As String　　　 'ダイアログに表示する文字列　　ulFlags　　　　 As Long　　　　 'オプションフラグ(BrowseInfoFlags) 　　lpfn　　　　　　As Long　　　　 'コールバック関数のアドレス　　lParam　　　　　As Long　　　　 'コールバック関数へのパラメータ　　iImage　　　　　As Long　　　　 'フォルダ用アイコンのシステムイメージリストID(不用のとき0) End Type '/////////////////////////////////////////////////////////////////////////////////////////// '共通定数 '/////////////////////////////////////////////////////////////////////////////////////////// Private Const MAX_PATH　　　As Long = 260&　　'パス長最大値 Private Const WM_USER　　　 As Long = &H400&　'アプリケーションメッセージコード範囲の開始値 '[BROWSEINFO]構造体使用ルートフォルダ(PID)列挙型定数(pidlRoot) Public Enum gEnumCSIDL 　　CSIDL_DESKTOP = &H0& 　　CSIDL_INTERNET = &H1& 　　CSIDL_PROGRAMS = &H2& 　　CSIDL_CONTROLS = &H3& 　　CSIDL_PRINTERS = &H4& 　　CSIDL_PERSONAL = &H5& 　　CSIDL_FAVORITES = &H6& 　　CSIDL_STARTUP = &H7& 　　CSIDL_RECENT = &H8& 　　CSIDL_SENDTO = &H9& 　　CSIDL_BITBUCKET = &HA& 　　CSIDL_STARTMENU = &HB& 　　CSIDL_MYDOCUMENTS = &HC& 　　CSIDL_MYMUSIC = &HD& 　　CSIDL_MYVIDEO = &HE& 　　CSIDL_DESKTOPDIRECTORY = &H10& 　　CSIDL_DRIVES = &H11& 　　CSIDL_NETWORK = &H12& 　　CSIDL_NETHOOD = &H13& 　　CSIDL_FONTS = &H14& 　　CSIDL_TEMPLATES = &H15& 　　CSIDL_COMMON_STARTMENU = &H16& 　　CSIDL_COMMON_PROGRAMS = &H17& 　　CSIDL_COMMON_STARTUP = &H18& 　　CSIDL_COMMON_DESKTOPDIRECTORY = &H19& 　　CSIDL_APPDATA = &H1A& 　　CSIDL_PRINTHOOD = &H1B& 　　CSIDL_LOCAL_APPDATA = &H1C& 　　CSIDL_ALTSTARTUP = &H1D& 　　CSIDL_COMMON_ALTSTARTUP = &H1E& 　　CSIDL_COMMON_FAVORITES = &H1F& 　　CSIDL_INTERNET_CACHE = &H20& 　　CSIDL_COOKIES = &H21& 　　CSIDL_HISTORY = &H22& 　　CSIDL_COMMON_APPDATA = &H23& 　　CSIDL_WINDOWS = &H24& 　　CSIDL_SYSTEM = &H25& 　　CSIDL_PROGRAM_FILES = &H26& 　　CSIDL_MYPICTURES = &H27& 　　CSIDL_PROFILE = &H28& 　　CSIDL_SYSTEMX86 = &H29& 　　CSIDL_PROGRAM_FILESX86 = &H2A& 　　CSIDL_PROGRAM_FILES_COMMON = &H2B& 　　CSIDL_PROGRAM_FILES_COMMONX86 = &H2C& 　　CSIDL_COMMON_TEMPLATES = &H2D& 　　CSIDL_COMMON_DOCUMENTS = &H2E& 　　CSIDL_COMMON_ADMINTOOLS = &H2F& 　　CSIDL_ADMINTOOLS = &H30& 　　CSIDL_CONNECTIONS = &H31& 　　CSIDL_COMMON_MUSIC = &H35& 　　CSIDL_COMMON_PICTURES = &H36& 　　CSIDL_COMMON_VIDEO = &H37& 　　CSIDL_RESOURCES = &H38& 　　CSIDL_RESOURCES_LOCALIZED = &H39& 　　CSIDL_COMMON_OEM_LINKS = &H3A& 　　CSIDL_CDBURN_AREA = &H3B& End Enum '[BROWSEINFO]構造体使用オプションフラグ列挙型定数(ulFlags) Public Enum BrowseInfoFlags 　　BIF_RETURNONLYFSDIRS = &H1 　　BIF_DONTGOBELOWDOMAIN = &H2 　　BIF_STATUSTEXT = &H4 　　BIF_RETURNFSANCESTORS = &H8 　　BIF_EDITBOX = &H10 　　BIF_VALIDATE = &H20 　　BIF_NEWDIALOGSTYLE = &H40 　　BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX) 　　BIF_BROWSEINCLUDEURLS = &H80 　　BIF_UAHINT = &H100 　　BIF_NONEWFOLDERBUTTON = &H200 　　BIF_NOTRANSLATETARGETS = &H400 　　BIF_BROWSEFORCOMPUTER = &H1000 　　BIF_BROWSEFORPRINTER = &H2000 　　BIF_BROWSEINCLUDEFILES = &H4000 　　BIF_SHAREABLE = &H8000 End Enum 'コールバック関数が受信するメッセージコード列挙型定数(uMsg) Private Enum BFFM_CallBackMsgCode　'　 [説明]　　　　　　[lParam] 　　BFFM_INITIALIZED = 1　　　　　 '初期化終了コード　　 NULL 　　BFFM_SELECTIONCHANGE = 2　　　 '設定変更コード　　　選択フォルダPID 　　BFFM_VALIDATEFAILED = 3　　　　'EditBox入力値エラー　EditBox入力値PID End Enum '[SendMessage]で[SHBrowseForFolder]に送信できるメッセージコード列挙型定数(wMsg) Private Enum BFFM_SendMsgCode　　　　　　 '　 [説明]　　　　　　[wParam]　　 [lParam] 　　BFFM_SETSTATUSTEXTA = (WM_USER + 100) 'ステータス変更　　　　　　　　設定するテキスト　　BFFM_ENABLEOK = (WM_USER + 101)　　　 'OKボタン有効/無効設定　　　　　0:無効,　以外:有効　　BFFM_SETSELECTIONA = (WM_USER + 102)　'初期フォルダの設定　　　 0　　フォルダPID 　　　　　　　　　　　　　　　　　　　　　'　　　　　　　　　　　　 1　　文字列のポインタ End Enum '/////////////////////////////////////////////////////////////////////////////////////////// 'モジュール内有効API定義 '/////////////////////////////////////////////////////////////////////////////////////////// '------------------------------------------------------------------------------------------- '[FindWindow](ウィンドウハンドルを返すAPI)宣言 ' '戻り値　　　　　　　　　　　　　　　　　　 0:失敗, 1:成功 ' '引数　　　　　　　 lpClassName　　　　　　対象クラス名(String) '　　　　　　　　　 lpWindowName　　　　　　対象ウィンドウのタイトル(String) '------------------------------------------------------------------------------------------- Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 　　　　(ByVal lpClassName As String, ByVal lpWindowName As String) As Long 　　　　　　　　　 '------------------------------------------------------------------------------------------- '[SHBrowseForFolder](フォルダ選択ダイアログAPI)宣言 ' '戻り値　　　　　　　　　　　　　　　　　　選択フォルダのPID(Long) ' '引数　　　　　　　 lpBrowseInfo　　　　　　[BROWSEINFO]構造体のアドレス(tagBROWSEINFO) '------------------------------------------------------------------------------------------- Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ 　　　　　　　　　　　　　　(lpBrowseInfo As tagBROWSEINFO) As Long 　　　　　　　　　　　　　　　　 '------------------------------------------------------------------------------------------- '[SHGetPathFromIDList](PIDをパス名に変換するAPI)宣言 ' '戻り値　　　　　　　　　　　　　　　　　　対象アイテムのパス名 ' '引数　　　　　　　 pidl　　　　　　　　　　対象アイテムのPID(Long) '　　　　　　　　　 pszPath　　　　　　　　対象アイテムのパス名(String) '------------------------------------------------------------------------------------------- Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ 　　　　　　　　　　　　　　(ByVal pidl As Long, ByVal pszPath As String) As Long 　　　　　　　　　　　　　　　　 '------------------------------------------------------------------------------------------- '[CoTaskMemFree](タスクのメモリブロックを解放するAPI)宣言 ' '引数　　　　　　　 pv　　　　　　　　　　　　　解放するブロックへのポインタID(Long) '------------------------------------------------------------------------------------------- Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) '------------------------------------------------------------------------------------------- '[SendMessage](指定されたハンドルへメッセージを送るAPI)宣言 ' '引数　　　　　　　 hwnd　　　　　　　　　　　　対象ウインドウハンドル(Long) '　　　　　　　　　 wMsg　　　　　　　　　　　　送信メッセージ(Long) '　　　　　　　　　 wParam　　　　　　　　　　　メッセージパラメータ１(Long) '　　　　　　　　　 lParam　　　　　　　　　　　メッセージパラメータ２(Long) '------------------------------------------------------------------------------------------- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ 　　(ByVal hwnd As Long, ByVal wMsg As BFFM_SendMsgCode, ByVal wParam As Long, lParam As Any) As Long 　　 '/////////////////////////////////////////////////////////////////////////////////////////// '共通変数 '/////////////////////////////////////////////////////////////////////////////////////////// Private mstrDefaultPath As String　　　　　　　 '初期表示フォルダ

・ツリー全体表示

【93】Re:フォルダ選択<FileDialog使用>

ちゃっぴ - 05/3/18(金) 23:48 -


	引用なし

	パスワード

Windows XP(2000) 以降だったかな？ Shell32 に Folder3 という Object ができて、表示される Shortcut の実体も透過的に扱える Self という Property が出来ました。 '[BROWSEINFO]構造体使用オプションフラグ列挙型定数(ulFlags) Enum BrowseInfoFlags 　　BIF_RETURNONLYFSDIRS = &H1 　　BIF_DONTGOBELOWDOMAIN = &H2 　　BIF_STATUSTEXT = &H4 　　BIF_RETURNFSANCESTORS = &H8 　　BIF_EDITBOX = &H10 　　BIF_VALIDATE = &H20 　　BIF_NEWDIALOGSTYLE = &H40 　　BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX) 　　BIF_BROWSEINCLUDEURLS = &H80 　　BIF_UAHINT = &H100 　　BIF_NONEWFOLDERBUTTON = &H200 　　BIF_NOTRANSLATETARGETS = &H400 　　BIF_BROWSEFORCOMPUTER = &H1000 　　BIF_BROWSEFORPRINTER = &H2000 　　BIF_BROWSEINCLUDEFILES = &H4000 　　BIF_SHAREABLE = &H8000 End Enum Function strBrowseForFolderPath( _ 　　ByRef strTitle As String, _ 　　Optional ByVal lngHwnd As Long = 0, _ 　　Optional ByVal lngOptions As BrowseInfoFlags = 0, _ 　　Optional ByRef strRoot As String = "") As String 　　　　Dim objShell As New Shell32.Shell 　　Dim objFolder As Shell32.Folder3 　　　　Set objFolder = objShell.BrowseForFolder( _ 　　　　lngHwnd, strTitle, lngOptions, strRoot) 　　If Not objFolder Is Nothing Then 　　　　If objFolder.Self.IsFileSystem = True Then 　　　　　　strBrowseForFolderPath = objFolder.Self.Path 　　　　　　Set objFolder = Nothing 　　　　End If 　　End If 　　Set objShell = Nothing End Function

・ツリー全体表示

【92】Re:グループ集計レポート

Jaka - 05/3/10(木) 14:06 -


	引用なし

	パスワード

こんにちは。

アクセスのご質問は、こちらにどうぞ。
http://www.vbalab.net/vbaqa/c-board.cgi?id=access

・ツリー全体表示

【91】Re:Excel 97 以降で、メニューを簡単に追加...

Jaka - 05/3/10(木) 13:53 -


	引用なし

	パスワード

メニューバーで検索してみたら、意外とメニューバーのマクロってないというか、残ってなかったので、谷さんと違う書き方です。
（普段は谷さんと同じようにsetした書き方をしてますけど....。）

Sub dnmm()
With Application.CommandBars("Worksheet Menu Bar").Controls
　　With .Add(Type:=msoControlPopup, Temporary:=True)
　　　　.Caption = "新メニュー"
　　　　With .Controls
　　　　　　With .Add(Type:=msoControlButton)
　　　　　　　　.Caption = "マクロ１"
　　　　　　　　.OnAction = "Mcro1"
　　　　　　End With
　　　　　　With .Add　'type略
　　　　　　　　.Caption = "マクロ２"
　　　　　　　　.OnAction = "Mcro2"
　　　　　　End With
　　　　　　With .Add(Type:=msoControlPopup)
　　　　　　　　.BeginGroup = True
　　　　　　　　.Caption = "マクロ３"
　　　　　　　　With .Controls.Add
　　　　　　　　　　.Caption = "マクロ３-１"
　　　　　　　　　　.OnAction = "Mcro3"
　　　　　　　　End With
　　　　　　End With
　　　　　　With .Add(Type:=msoControlPopup)
　　　　　　　　.Caption = "マクロ４"
　　　　　　　　With .Controls
　　　　　　　　　　 With .Add
　　　　　　　　　　　　 .Caption = "マクロ４-１"
　　　　　　　　　　　　 .OnAction = "Mcro4-1"
　　　　　　　　　　 End With
　　　　　　　　　　 With .Add
　　　　　　　　　　　　 .Caption = "マクロ４-２"
　　　　　　　　　　　　 .OnAction = "Mcro4-2"
　　　　　　　　　　 End With
　　　　　　　　End With
　　　　　　End With
　　　　End With
　　End With
End With
End Sub

・ツリー全体表示

【90】グループ集計レポート

Rika - 05/3/7(月) 18:11 -


	引用なし

	パスワード

レポートの新規作成で、レポートウィザードを使用し、選択したフィールドを入れ、次へ進むと、「インデックスが有効範囲にありません」とメッセージがでます。どこがおかしいのでしょうか？教えて下さい。

・ツリー全体表示

【89】Re:一応、全部？の祝日です。

ponpon

- 05/3/6(日) 20:53 -


	引用なし

	パスワード

ponponです。
　春分の日=DATE($B$1,3,DAY(INT(20.8431+0.242194*($B$1-1980) _
　　　　　 -INT(($B$1-1980)/4))))
　

　秋分の日=DATE($B$1,9,DAY(INT(23.2488+0.242194*($B$1-1980)- _
　　　　 INT(($B$1-1980)/4))))

確か2100年までいけたと思います。（死んでるので意味ないですが）

・ツリー全体表示

【88】一応、全部？の祝日です。

Jaka - 05/2/28(月) 11:27 -


	引用なし

	パスワード

B1に西暦年を入れるとその年の祝日がでます。
春分秋分の求め方はわかりません。
また、祝日で固定してはいけないところを固定していたらすみません。

元日　　　　　=DATE($B$1,1,1)
年末年始　　　=DATE($B$1,1,2)
　〃　　　　　=DATE($B$1,1,3)
成人の日　　　=DATE($B$1,1,IF(2>=WEEKDAY(DATE($B$1,1,1),1),2-WEEKDAY(DATE($B$1,1,1),1)+((2-1)*7)+1,8-WEEKDAY(DATE($B$1,1,1),1)+((2-1)*7)+2))
建国記念の日　=DATE($B$1,2,11)
春分日　　　　カレンダーを見て下さい。
みどりの日　　=DATE($B$1,4,29)
憲法記念日　　=DATE($B$1,5,3)
国民の休日　　=DATE($B$1,5,4)
こどもの日　　=DATE($B$1,5,5)
海の日　　　　=DATE($B$1,7,IF(2>=WEEKDAY(DATE($B$1,7,1),1),2-WEEKDAY(DATE($B$1,7,1),1)+((3-1)*7)+1,8-WEEKDAY(DATE($B$1,7,1),1)+((3-1)*7)+2))
敬老の日　　　=DATE($B$1,9,IF(2>=WEEKDAY(DATE($B$1,9,1),1),2-WEEKDAY(DATE($B$1,9,1),1)+((3-1)*7)+1,8-WEEKDAY(DATE($B$1,9,1),1)+((3-1)*7)+2))
秋分の日　　　カレンダーを見て下さい。
体育の日　　　=DATE($B$1,10,IF(2>=WEEKDAY(DATE($B$1,10,1),1),2-WEEKDAY(DATE($B$1,10,1),1)+((2-1)*7)+1,8-WEEKDAY(DATE($B$1,10,1),1)+((2-1)*7)+2))
文化の日　　　=DATE($B$1,11,3)
勤労感謝の日　=DATE($B$1,11,23)
天皇誕生日　　=DATE($B$1,12,23)
年末年始　　　=DATE($B$1,12,31)

・ツリー全体表示

【87】オートフィルタしたデータ抽出時の不具合の...

Jaka - 05/2/21(月) 17:20 -


	引用なし

	パスワード

オートフィルタしたデータを抽出する際、下記の様なコードは、とんでもない落とし穴が潜んでいます。
抽出データ範囲の1件目に1件しかないデータを抽出すると、とんでもない結果になります。
一見効率がよさそう、見た目がよさそう、スマートな書き方（どこがスマートだかわかりませんが．．．）と言う理由なら止めた方がいいです。

Range("A2", Range("A65536").End(xlUp)).SpecialCells(xlCellTypeVisible)

私も効率がよさそうだと言う理由で、今までのパターンと変えて、このパターンで1度、似たようなパターンで

1度回答してしまった事があります。
この欠点に気づかなければ、多分ずっとこのパターンを使用していたかもしれません。

オートフィルタするデータが、こんな感じだとして、下記コード注意1～3を実行してみてください。

　　A
1　項目A
2　　8　←　この位置のデータを抽出する際、同じ物が他に無いと問題が起こります。
3　　9
4　　2
5　　1
6　　2
7　　3
8　　3
9　　1
10　 4
11　 4
12　 7
13　 3
14　 5
15　 1
16　 6

Sub 注意1()
　　Dim AR As Long, MyRag As Range

　　'AR = Range("A65536").End(xlUp).Row　　'←　フィルタする前の最終行を使えば大丈夫です。

　　Range("A1").AutoFilter Field:=1, Criteria1:="8"

　　'オートフィルタ後に表示されている最後の行を使った方が効率がよさそうに見えますが、
　　'↓　ここにあるととんでもないことになる。
　　AR = Range("A65536").End(xlUp).Row

　　Set MyRag = Range("A2:A" & AR).SpecialCells(xlCellTypeVisible)
　　MsgBox "抽出されたセルアドレス " & MyRag.Address
　　MyRag.Select

　　ActiveSheet.AutoFilterMode = False
　　Set MyRag = Nothing
End Sub

Sub 注意2()
　　Dim MyRag As Range
　　Range("A1").AutoFilter Field:=1, Criteria1:="8"

　　'注意1と同じパターン
　　Set MyRag = Range("A2", Range("A65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
　　MsgBox "抽出されたセルアドレス " & MyRag.Address
　　MyRag.Select

　　ActiveSheet.AutoFilterMode = False
　　Set MyRag = Nothing
End Sub

Sub 注意3()　 '注意１と同じですが、フィルタする範囲を指定。
　　Dim AR As Long, MyRag As Range
　　AR = Range("A65536").End(xlUp).Row

　　Range("A1:A" & AR).AutoFilter Field:=1, Criteria1:="8"
　　Set MyRag = Range("A2", Range("A65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
　　MsgBox "抽出されたセルアドレス " & MyRag.Address
　　MyRag.Select

　　ActiveSheet.AutoFilterMode = False
　　Set MyRag = Nothing
End Sub

要するに、抽出する時にフィルタする前の範囲とフィルタした後の範囲を、見た目で判断して変えてはダメだと言うことなんでしょうか？

by
Win98se & EXL2000SR-1
Win2000 & EXL97
Win2000 & EXL2002

・ツリー全体表示

┃ ┃一覧表示 ┃ ┃ ┃ ┃

10 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free