Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18208 / 76732 ←次へ | 前へ→

【63967】会とぷその3:どの構文を使えばいいのか教えて下さい
回答  [名前なし]  - 10/1/5(火) 18:08 -

引用なし
パスワード
   コードの記述

  まず、シート上のコントロールをクリックしてできあがるシートモジュール上
  に必要なコードを書くことからはじめてもいいのですが、以下にコードを
  貼り付けますのでそれを指定のモジュールにコピペするほうが早いですね。
  なお、FileSystemObjectを使用しますのでMiscrosoft Scripting Runtime に
  参照設定をしておいてください。

【ワークブックモジュール】

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

 If flag正常終了 = False Then
  MsgBox "終了時は必ず終了ボタンを押してください"
  Cancel = True
 Else
  If Workbooks.Count = 1 Then Application.Quit
 End If
 
End Sub

Private Sub Workbook_Open()

 一覧作成
 
End Sub

【シートモジュール】

Option Explicit

Private Sub btn_20_Click()
 age絞込み 20
End Sub

Private Sub btn_30_Click()
 age絞込み 30
End Sub

Private Sub btn_40_Click()
 age絞込み 40
End Sub

Private Sub btn_AllAge_Click()
 age絞込み 99
End Sub

Private Sub btn_AllJob_Click()
 job絞込み 99
End Sub

Private Sub btn_SE_Click()
 job絞込み "SE"
End Sub

Private Sub btn_営業_Click()
 job絞込み "営業"
End Sub

Private Sub btn_事務_Click()
 job絞込み "事務"
End Sub

Private Sub btn_終了_Click()
 終了
End Sub

【標準モジュール】

Option Explicit
'【参照設定】 Microsoft Scripting Runtime (FileSystemObject使用)

Public flag正常終了 As Boolean
Const myFolder = "c:\Documents and Settings\user\My Documents" '<==抽出フォルダを規定
Const myExt = "xls" '<==2003
Const myCat=12   '<==2003

Sub 一覧作成()
Dim myLine As Long
Dim wkAge
Dim wkJob
Dim itsMe As String
Dim myFSO As Scripting.FileSystemObject
Dim myBook As Scripting.File
Dim GDOFolder As Object
Dim myCategory As String
Dim aaa

 Set myFSO = New Scripting.FileSystemObject
 Set GDOFolder = CreateObject("Shell.Application").Namespace(myFolder)

 itsMe = ThisWorkbook.Name
 
 With ActiveSheet
 
 myLine = 3
 
 For Each myBook In myFSO.GetFolder(ThisWorkbook.Path).Files
 
  If LCase(myFSO.GetExtensionName(myBook.Name)) = myExt And _
    myBook.Name <> itsMe Then
   
    .Hyperlinks.Add Anchor:=.Cells(myLine, 1), _
           Address:=myFolder & "\" & myBook.Name, _
           TextToDisplay:=myBook.Name
           
    wkAge = ""
    wkJob = ""
   
    myCategory = GDOFolder.GetDetailsOf(GDOFolder.ParseName(myBook.Name), myCat)
    If myCategory <> "" Then
     aaa = Split(myCategory, "/")
     wkAge = aaa(0)
     If UBound(aaa) >= 1 Then wkJob = aaa(1)
    End If
   .Cells(myLine, 2).Value = wkAge
   .Cells(myLine, 3).Value = wkJob
   
   myLine = myLine + 1
  
  End If
  
 Next
 
 .Range("A2").CurrentRegion.AutoFilter
 
 End With
 
 Set myFSO = Nothing
 
End Sub

Sub 終了()

 flag正常終了 = True
 ThisWorkbook.Close savechanges:=False
 
End Sub

Sub age絞込み(btnVal)

 If btnVal = 99 Then
  ActiveSheet.Range("A2").CurrentRegion.AutoFilter field:=2
 Else
  ActiveSheet.Range("A2").CurrentRegion.AutoFilter field:=2, Criteria1:=btnVal
 End If

End Sub

Sub job絞込み(btnVal)

 If btnVal = 99 Then
  ActiveSheet.Range("A2").CurrentRegion.AutoFilter field:=3
 Else
  ActiveSheet.Range("A2").CurrentRegion.AutoFilter field:=3, Criteria1:=btnVal
 End If
 
End Sub
0 hits

【63956】どの構文を使えばいいのか教えて下さい ユーリ 10/1/3(日) 23:40 質問
【63960】Re:どの構文を使えばいいのか教えて下さい [名前なし] 10/1/4(月) 15:19 発言
【63961】Re:どの構文を使えばいいのか教えて下さい ユーリ 10/1/4(月) 21:27 発言
【63962】Re:どの構文を使えばいいのか教えて下さい [名前なし] 10/1/5(火) 9:04 発言
【63972】Re:どの構文を使えばいいのか教えて下さい ユーリ 10/1/5(火) 23:14 発言
【63965】回答その1:どの構文を使えばいいのか教え... [名前なし] 10/1/5(火) 18:02 回答
【63966】回答その2:どの構文を使えばいいのか教え... [名前なし] 10/1/5(火) 18:06 回答
【63968】回答その2の訂正 [名前なし] 10/1/5(火) 18:12 回答
【63971】【重要な説明漏れ】回答その2:どの構文を... [名前なし] 10/1/5(火) 19:10 回答
【63967】会とぷその3:どの構文を使えばいいのか教... [名前なし] 10/1/5(火) 18:08 回答
【63969】【バグあり】回答その3:どの構文を使えば... [名前なし] 10/1/5(火) 18:52 回答
【63970】【デバッグ完了】回答その3:どの構文を使... [名前なし] 10/1/5(火) 19:03 回答
【64020】Re:どの構文を使えばいいのか教えて下さい ユーリ 10/1/10(日) 12:04 お礼

18208 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free