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

Mail … 1
0ption Explicit
Subメール作成0
Dim oApp As Object 'Outlookのオブジェクト
Dim objMA:L As Object 'メールのオブジェクト
Dim strMOJI As String 冽トラt
Dim strSign As String '署名
Dlm strTMP(6)As Strlng'添付ファイル
Dim strCL(7)As String '改行コード
Dim : As Var:ant
Set oApp = CreateObjeCt(″Outlook.Application″)
Set objMAIL = oApp.Createltem(0)
objMAIL.display'編集画面を表示
objMAIL.SentOnBehalfOfName=Range(″差出人″) 'メール画面には表示されないが裏で設定される
objMAIL.To = Range(″'Lうし″)
objMAIL.CC = Range(″CC″)
objMAIL.Bcc = Range(″BCC″) .
objMAIL.Subject=Range(″件名1″)&Range(″件名2″)&Range(″件名3″)&Range(″件名4″)&Range(″件名5″)
'添付ファイル
For i = l To 5
1f Not isEmpty(Range(″添付ファイル″&i))Then
strTMP(l)=Range(″添付ファイル″&i)
objMAIL.Attachments.Add strTMP(1)
End lf
Next i
'改行コード取得
For i = l To 5
1f Not lsEmpty(Range(″日彙`予″ & i)) Then
strCL(i) 〓 vbCrLf
End lf
Next i
'本文
'strMO」l = Range(″フトラtl″)& strcL(1) & Range(″フトラt2″) & strCL(2) & Range(″フトラに3″)& strCL(3)& _
Range(″フトラt4″)& strCL(4) & Range(″フトラt5″) & strCL(5) & _
vbCrLf&Range(″署名″)&strCL(6)&Raηge(″本文6″)
objMAIL.Body = Range(″フト5に1″) & strCL(1) & Range(″冽ド5t2″) & strCL(2) & Range(″冽ドがt3″) & strCL(3) & _
Range(″フトラに4〃)& strCL(4)& Range(″冽ヽ〕t5″)& strCL(5)& _
vbCrLf&Range(″署名″)&strCL(6)&Range(″本文6″)
'str∥OJl
objMA:L.BodyFormat = 2
obj∥AIL.Save'下書き保存
Set obJMAIL = Nothing
Set oApp = Nothing
End Sub
Subメール作成2()
Dim oApp As Object'Outlookのオブジェクト
'Dim objMAIL As Object'メールのオブジェクト
Dim obj∥AIL 'As Out16ok.Mailltem
Dim strMOJI As String コドラt
Dim strSign As String'署名
Set oApp 〓 CreateObject(″Outlook.Application〃)
Set objMAIL = oApp.Createltem(0)
objMAIL.display'編集画面を表示
objMAIL.SentOnBehalfOfName=Range(″差出人″)
objMAIL To=Range(〃宛先″)
objMAIL.CC = Range(″CC″)
objMAIL.Bcc = Range(″BCC″)
objMAIL.Subject=Range(″件名1″)&Range(″件名2″)&Range(″件名3″)&Range(″件名4″)&Range(″件名5″)

Mail - 2
'添付ファイルのパス
strTMP(3)=Range(〃添付ファイル1″)
strTMP(3)=Range(″添付ファイル2″)
strTMP(3)=Range(〃添付ファイル3″)
strTMP(4)=Range(″添付ファイル4″)
strTMP(5)=Range(″添付ファイル5″)
objMA:L.Attachments.Add strTMP(1)'☆空欄だとエラーになる
objMA:L.Attachments.Add strTMP(2)
objMAIL.Attachments.Add strTMP(3)
objMAIL.Attachments Add strTMP(4)
objMAIL.Attachments Add strTMP(5)
'ob」MAIL.Attachments.Add Range(″添付ファイル1″)'エラーになる
'本文
'str∥OJl=″こんにちは:″'改行はvbCrLf
obj∥AIL.Body = strMOJI
str∥0」| = Range(″フト,tl″) & Range(″]女`子1″) & Range(″フト,t2:な(9冽:::評∫″:F`]i:な(9117:ジ∫″:'〕t3″) & Range(″1彙イテ3″) & _
Range(″本文4″)&Range(″改行4″)&Ran
vbCrLf&Range(″署名″)&Range(″改行6″)&Range(″本文6″)
objMAIL.3ody = strMOJl
'ob」MAIL.BodyFormat=olFormatHTML 'エラーになる
objMAIL.Save'下書き保存

Subメールイ乍成10
Dim oApp As Object'Outlookのオブジェクト
Dim objMAIL As Object'メールのオブジェクト
Dim strMO」l As String '本文
'Dim strSign As String'署名
::[ :::lATLCtte:1:::::::1:♀せ:∥,8,・Application″)
objMAIL.display'編集画面を表示
'★エラーにならないけど無反応

g
n

hg
tn
O・‥
Nh
t
一一 〇
N
L
―〓
A
Mp
・Jp b
hYA u
00 S

tt d
ee n
SS E

'objMA
'obj∥A
'ob」MA
'objMA
'obJMA
'objMA
'obJMA
'objMA

L.SendUsingAccount = ″inaba_yumiko@smbcnikko.co.jp″
L.SendUsingAccount=″lnaba Yumiko/稲葉裕美子/リスク管理課″
[:鍵1181::∥:|::f∥:∥: : ″11:::一羊廿∥|∥:9消霙nlさ霙撃,1」;kク管理部ィンレジ》ッ トリ,スク管理言果″
[:::11:|:″ll:::一羊廿∥|∥:%溜曇巽囃∫:巽撃,I」要ク催コ里部リラく`ア催ヨヨ里調:″
[:鷺1181::∥:lf:「∥:∥: : ″11:::一羊廿∥|∥:9消霙n妹羹撃,1」;リ,スク管理言果″

'★値の参照のみ可能
,::l船|[:鷺1:erNal:aLarr羊∥]:1°♀:∥ll:,籍異C称羹隼/り,スクリ,スク管理言果″
'☆オブジェクトが見つかりません
り嘗I』よゞり!;ti、撃嬰り[よ量菫!;l::|:::[|:::|“:も:hiF雷ピ足:習≦i首主鱗!'∫:i::l:[::11;|::,9丁∥::lk♀9i∥∥:,1略讐ξ晟::異年)リス
'objMAIL Sender = oApp.Session.AddressLists(″Exchange Server″).AddressEntries(″inaba_yumiko″)
'★変数定義が不正
i COnS:ilE::〕R認::l:NIs=A::::∥:―yumik°OSmbcnikko.co.jp″
1 瀧: ::llil::ξ:nttu:lili」1:[bli:Sl°:bli:::11:(SE00ND_ACCOUNT) '―AccountがЙFIE?
'★不正なプロパティ
||:lililillll西!:!|III::lilli:::|:!||||:ll:lll;:ζ♀:hll:counts(SECOND_ACCOUNT)

Mail - 3
objMAIL.To=″Kojima Rika/小島/リスク管理課″
obj∥AIL.CC=″Watanabe Noriaki/渡辺章/リスク管理課″
obj∥AIL.Bcc=″Nambu Yosuke/南洋介/リスク管理課″
objttA:L.Subject=″テスト2″
'添付ファイルのパス
obj∥A!L.Attachments.Add″￥￥ntcモニタリング￥業者moni￥与信枠モニタリング【業
者】20150602.xlsx″
obj∥AIL.Attachments.Add″￥￥ntc￥モニタリング￥業者moni￥信託ロスキーム20150602.xlsx″
'本文
str∥OJ!=″こんにちは:″'改行はvbCrLf
obj∥AIL.Body = str∥OJl
objMAIL.Save'下書き保存
Set obj∥AIL = Nothing
Set oApp = Nothing
End Sub

Mal12 - 1
0ption Explicit
Sub図の貼り付け0
With oApp.Activelnspector.WordEditor.Windows(1)
Range(″Al:D10″).Oopy
.Selection.Paste
Application.CutCopy∥ode = False
End With
End Sub
Subリッチテキスト形式で貼付0
With oApp.Activelnspector.WordEditor.Windows(1)
Range(″Al:D10″).Oopy
.Selection.PasteExcelTable Faise, False, True
Application.CutCopyMode = False
End With
End
'構文
Selection.PasteExcelTable [L:nkedToExcel], [WordFormatting], [RTF]
'LinkedToExcel …必須。True=リンク付 /FAlse〓非リンク
'WordFormatt rng,..必須。True=Word文書の書式を採晨RTF)で貼付′「:|:::需縦E鬱製暴晶各ルの書式を採用
'RTF …必須。True〓リッチテキスト形式
End Sub
Sub拡張メタファイルで貼付0
With oApp.Activelnspector.WordEditor.Windows(1)
Range(″Al:D10″).OopyPI`ture '拡張メタファイルとしてコピー
.Selection.Paste
Application.CutCopy∥ode = False
End W:th
End Sub
Sub選択範囲を貼付0
Dim Ap As Object ・
Di口 ∥ As Object
s:|::橋澤蕊出ているものをコピー(図でも表でもOKです)
::: lp==A:l:『::::|::l(:,utl°°k.App:ication〃)

レジットリスク管理課″ 'アドレス
∥i鶴Sil,Ictiveinspector '画面を表示
'員占りf寸け
.WordEditor.Windows(1).Selection.Paste
End With
End Sub

Mai13 … 1
0ption Explicit
Sub別名保存0
Set oApp = CreateObject(″Outlook Application″)
Set obj∥AIL = oApp.Createltem(0)
'/Bodyフォーマット(1:テキスト形式、2:HTML形式、3:リッチテキスト形式)
objMAIL.BodyFormat = 2
obj∥AIL.display'編集画面を表示
'メール作成コードいろいろ
'/件名を保存ファイル名にする→不適切な文字を置換
strFileName = objMAIL.Subject & ″.msg〃
ReplaceCharsForFileName strFileName, ″_″
Debug.Print strFiieName
'/メールの保存(指定フォルダ)※テストメールは保存しない
objMAIL.SaveAs″c:￥″&strFileName 'ファイルの種類(Type)を指定しない場合はMSG形式(.msg)
'※OutlookのSaveAsメソッドのType:
'olHT∥L、olMSG、olRTF、olTemplate、o:Doc、 olTXT、olVCal、olVCard、o H Cal、 またはolMSGUnicode(値(数字)でOK)
End Sub
Subメールウィンドウを閉じる0
…
Set oApp = CreateObject(″Outlook.Application″)
Set objMAIL 〓 oApp.Createltem(0)
'/Bodyフォーマット(1:テキスト形式、2:HTML形式、3:リッチテキスト形式)
objMAIL.BodyFormat = 2
objMAIL.display'編集画面を表示
'メール作成コードいろいろ
'/メールウィンドウを閉じる
objMAIL.Close l
'※OutlookのCioseメソッドの保存モード:
'olDiscard l ドキュメントに対する変更内容を破棄
|:|::::ptForSave る 倭奪=23f暑襟暮硼露
End Sub

Modulol - 1
0ption Explicit
Sub戻り値のマクロ0
Dim a As Strlng
Dim i As lnteger 'ループカウンタ(Sheetlの行数を指す)
For i = 2 To 6
'A列とSheetlのB列をかけて、SheetlのC列で割った値をSheetlのD列に入れる
Sheets(″Sheet3″).Range(″B″ & i).Value = TEST2(Sheets(rsheet3″)f Range(″A″ & i).Value)
Next i
End Sub
Fサliti♀llTi:T〔`1:Al:も,ξl:tring) As Long
Dim : As Long
i=2
Do While Sheets(″Sheet4″).Range(″A″ & i) く〉 ″″
if ATA12 〓 Sheets(″Sheet4″).Range(″A″ & i).Value Then
TEST2 = TEST2 + Sheets(″Sheet4″).Range(″B″ & i).Value
End lf
i=i+1
Loop
End Function
Sub TESTl()
'TEST2を呼んで結果を受け取りたい
Dim変数As Long
変数=1
Call TEST3(変数)
MSgBOX変数
End Sub
Pi:き♀lλ、首蹂懇洒警垢習与甥歩習じ_ジャ
'★マクロの表示ボックスに表示されない
MSgBOX変数
'TESTlで宣言した「変数」に値をセット
HENSU = 9
End Sub
Subレンジ指定0
Dim wLine As lnteger
wLine = 2 ・
MsgBox CStr(wLine) .
MsgBox Range(″G″ + CStr(wLine)).Value
MsgBox Range(″G″ & wLine).Value
Range(″J5″) = CStr(wLine)
End Sub
Sub Sample()
Dim a As Double, tmp As Variant
a = 12 345678
tmp = CStr(a)
MsgBox tmp+″″+VarType(tmp) '文字列型(8)を返します
End Sub
Subこのワークブックo
Workbooks(″Book2.xlsx″).Activate
ThisWorkbook.Activate
End Sub
Subオープンイベント0
Workbooks.Open ″C:￥Users￥9002715￥Documents￥Today￥Book2.xlsm″
End Sub

Option Explicit
Subプロシージャ名の取得0
Dim ProcName As String ‐
ProcName = ThisWorkbook.VBProject.VBComponents(″∥odule4″).Code∥odule.ProcOfLine(5, 0)
MsgBox ProcName
'″Other″ はモジュール名(∥odulelなど)
1磐曇:〕[J墨馨l栞i:ソ亀多讐整∥倦峯経言見そご思ぶ酉ご1熟15重二んあ碁出を捨達。
,I顕鶴嗅ubプご3主ライ革R驚響庶琴吉窃笙レャを指定するときは0を指定。
End Sub