忍者ブログ
  • 2025.05《
  • 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
  • 》 2025.07
[PR]
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

2025/06/19 23:25 |
File
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
2016/04/19 00:07 | VBA | コメント(0)
<<Common | ホーム | Mail>>
コメント
コメントの投稿















前ページ | ホーム | 次ページ