× [PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。 |
![]() |
File-1
0ption Explicit 'WindowsのAPi(ネットワァクドライブに変更で使用) Declare Function SetCurrentDirectory Lib ″kerne132″ Alias ″SetCurrentDirectoryA″ (ByVal CurrentDir As String)As Long Subネットワークドライブに変更0 'ドライブ文字を割り当てていないネットワークドライブにカレントドライブを変更(上記WindowsのAPIを使用) SetCurrentDirectory ″¥¥ncs―fis-08¥risk…828¥″ MsgBox CurDir End Sub Subエクセルに戻る0 'OutlookやWordなどに移動した後、Excelに戻る AppActivate ″∥icrosoft Excel″, False End Sub Subカレントフォルダ0 'CurDir…カレントフォルダ MsgBox″カレントフォルダは r&curDir&″ です。 ″ End Sub Subドライブの変更0 ChDrive″F″ 'ドライブ文字のみ MsgBox″カレントディレクトリは ″&CurDir&″ です。 ″ ChDir″F:¥与信管理課¥与信管理¥モニタリング” MsgBox″カレントディレクトリは ″&CurDir&″ です。 ″ 'ChDir ThisWorkbook Path End Sub Subフアイルを探す0 'For Eachでも探せるがこの方が簡単だと思う Dim a As Str:ng On Error GoToファィルが見つからない a=inputBox(″ファイル名を入力してください。 ″) 'フアイルが見つかつた: Workbooks(a).Activate MsgBox″お探しのブックがありました。 ″,vblnformation Exit Sub フアイルが見つからない: MsgBox″お探しのブックはありません。 ″,vbCritical End Sub Subフォルダを探す1() Dim strFilePath As String strFilePath = ″C:¥Users¥9002715¥Documents¥test″ lf Dir(strFilePath, vbDirectory) = ″″ Then MsgBox″指定されたファイルパスが見つかりません。 ″,vbExclamation Else MsgBox″指定されたファイルバスが見つかりました。 ″,vblnformation End !f End Sub Subフオルダを探す2() Dim objFlleSys As Object ' Dim strScriptPath As String Dim strDeleteFrom As String '/テキストファイルやフォルダを操作するためCreateObject関数でScripting.FileSystemObjectのインスタンス作成 File=2 Set objFileSys = CreateObject(″Scripting.FileSystemObject″) ' strScrlptPath = ThisWorkbook.Path ' strDeleteFrom = objFileSys.BuildPath(strScriptPath, ″backup¥dat1221″) strDeleteFrom = ″¥¥yvd―rsk-02¥EUCll_Data¥20151001″ ' strDeleteFrom = Range(″A2″) if obJFileSys FolderExists(strDeleteFrom) = True Then ' objFileSys.DeleteFolder strDeleteFrom, True MsgBox strDeleteFrom&″が見つかりました ″ ' Debug.Print″[BackUp]から[dat1 221]を削除しました。″ ActiveWorkbook.SaveAs Filename:=strDeleteFrom & ″¥″ & ″申朱1′01.xisx″ E:se MsgBox strDeleteFrom&″は見つかりませんでした: ″ ' Debug,Print″[BackUp]に[dat1221]がありません。″ MkDir strDeleteFrom ActiveWorkbook.SaveAs Filename:=strDeleteFrom & ″¥″ & ″夕朱lノJド02.xlsx″ End lf Set objFileSys = Nothing End Sub Subフアイル名取得0 拡張子を除いたファイル名 x = Left(ActiveWorkbook Name, lnStrRev(ActiveWorkbook.Name, ″.″) - 1) 拡張子のみ x = Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) ― lnStrRev(ActiveWorkbook.Name, ″.″)) End Sub Subフアイルを開く0 Workbooks.Open Filename:=〃G:¥Users¥9002715¥Documents¥Today¥Book2.x:sx″ End Sub Subフアイルを開いてイベントを実行0 '他のブックのマクロVBAでOpenした場合、Workbook_Openは起動されますが、Auto_Openは起動されません。 'WorkbooにOpenは、ThisWorkbookに記述 …VBA起動で実行される 'Auto_Openは、標準モジュールに記述 …VBA起動で実行されない Workbooks.Open Filename:=″C:¥Users¥9002715¥Documents¥Today¥Book2 xlsm″ 'Aut吐Openを実行したい場合は上記のOpenイベントに続いて、 |::|」liti°n・Run ″Book2.xlsm!Auto_Open″ Workbooks(″3ook2.xlsm″).RunAutoMacros Which:=xlAutoOpen 'RunAuto∥acros`DWhich:= 'x:AutoActivate 'xlAutoClose 'x:AutoDeactivate 'x:AutoOpen End Sub Subフアイルを開いてイベントを実行テスト0 Workbooks.Open Filename:=″C:¥Users¥9002715¥Documents¥Today¥Book2.xlsm″ Workbooks(″Book2 xlsm″).RunAutoMacros Which:=xlAutoOpen End Sub Subフアイルを別名保存する0 ActiveWorkbook.SaveAs Filename:=(″G:¥Users¥9002715¥Documents¥Bookl.xlsx″) End Sub Subフアイルのコピニを保存する0 ActiveWorkbook SaveCopyAs Filename:=(″C:¥Users¥9002715¥Documents¥Book2.xlsx″) End Sub File-3 Subフアイルがあつたら削除して新規作成0 '同じ名前のファイルがあつたら削除して、新規作成 lf Dir(〃C:¥Users¥9002715¥Documents¥Book20.xlsx″) 〈〉 ″″ Then Kill ″C:¥Users¥9002715¥Documents¥Book20.xlsx″ End lf ActiveWorkbook.SaveAs Filename:=(″G:¥Users¥9002715¥Documents¥Book19.xlsx″) End Sub SubフアイルをCsv保存0 'csv保存の時は必ずLocal:=Trueを追加する Workbooks.Add.SaveAs Filename:=″C:¥Bookl csv″, FileFormati=xlCSV, Local:=True End Sub Sub複数のシートを選択する0 Sheets(Array(″Sheetl″,″Sheet2″)).Select 'SheetlとSheet2を選択 Sheets(″Sheetl″).acivate 'Sheetlをアクティブにする End Sub Subオブジェクトの削除0 'ォブジェクト(ボタンなど)に名前を付けて、確実に処理できるようにする ActiveSheet.Shapes.Range(Array(″出力″)).Delete End Sub Subこのファイルの名前0 MsgBox ThisWorkbook.Name End Sub Sub現在のネットワークドライブー覧0 Dim objNwtWork As Object Dim objDrv As Object Dim x As Long Dim : As Long '書き込みシートをアクティブに ThisWorkbook.Worksheets(″ファイル名とか″).Activate '既存データのクリア Range(Range(″ドライブ名″),Range(″ドライブ名″).Offset(7, 1)).ClearContents x=Range(″ドライブ名″).Row 'ネットワークオブジェクトを作成します Set objNwtWork = CreateObject(″WScript.Network″) '①ネットワークドライブの一覧を取得します Set objDrv = objNwtWork.EnumNetworkDrlves '②情報の数はCountプロパティで参照します For istt」トリ聖り・ドツ撃Jお稽報を集示します ' Debug.Print″ドライブ名″&objDrv.ltem(i)&″,パス″&objDrv.ltem(i+1) lf objDrv. ltem(i) = ″″ Then Celis(x,1).Value〓″未設定″ Else Cells(x, 1).Value = objDrv. Item(i) End lf Cells(x, 2).Value 〓 objDrv. ltem(i + 1) X=X+1 Next Set objDrv = Nothing End Sub Subウィンドウの切り替え0 With ActiveWindow Height = 410 Width = 960 FIle‐4 ` . :[::t=」1 ´ End With Range(″C28″):Activate End Sub subヮ‐クシT卜のスクロール0 '指定した行が一番上にくる ActiveWindow.ScrollRow = 2 '指定した列が一番左にくる ActiveWindow.ScrollColumn 〓 20 End Sub Sulアクティブ0 Windows(″担保額一覧(1).cSv″).Activate Range(″Al:A01″).Select Range(Selection, Selection:End(xlDown)).Select Selection.Copy Windows(″リテールデリバモニタリング_Ver3.xism″):Activate Sheets(″RAMS_担保額二覧″).Select Range(″Dl″).Select Selection.PasteSpecial Paste:=xlPasteValueS, Operation:=x:None, SkipBlanks:〒False, Translose:=False End Sub PR |
![]() |
![]() |
|
![]() |