タグ別アーカイブ: メール送付

虎の巻

エクセルVBA虎の巻

2024年7月20日 analytic-vba コメントをどうぞ

この記事では、私がこれまでVBAを使用してきた中で「これは使える」と思ったコードを抜粋したものです

ファイル保存

エクセルシートのCSV出力

出力したいシートをコピーして、新しいファイルを作成し、ファイル名を指定して保存します

ThisWorkbook.Worksheets(“出力”).Copy
ActiveWorkbook.SaveAs “D:\TEST.csv”, FileFormat:=xlCSV
ActiveWorkbook.Close

文字列操作

分割

文字列の分割にはSplitを使用します

Variant型で設定した変数をSplitで分割し、変数(0)、変数(1)、変数(2)で受け取ります

例えば、シートのB1セルに「600-1」の文字列があるとします

こちらの文字列を「-」で分割し、それぞれをメッセージで表示するとします

その場合は、次のコードで実現できます

Dim mySTRING As Variant
Dim myWORD As Variant
Dim myYEAR As String
Dim myMONTH As String

mySTRING = Worksheets(“Sheet1”).Range(“B2”).Value

myWORD = Split(mySTRING, “-“)

myYEAR = myWORD(0)

MsgBox myYEAR

myMONTH = myWORD(1)

MsgBox myMONTH

まず、myWORD(0)で600を取りだします

次にmyWORD(1)で1を取り出します

固定文字が含まれているかを判断する

Instr関数を使用し、０以上なら含まれていると判断します

Dim myCountWaritsuke As Long ‘固定の文字が含まれいる位置
myCountWaritsuke = InStr(“myTEST1”, “TEST”)

MsgBox myCountWaritsuke

上のコードの場合は、myTESTの文字列の3文字目にTESTの文字列が含まれているので3とメッセ―ジが出力されます

文字列への変換

数値の文字列への変換にはStr関数を使用します

Str関数を交えた下のコードを実行してみます

Dim myVal As Long

myVal = 1

Worksheets(“Sheet1”).Range(“B2”).Value = “A-” & Str(myVal)

するとB2セルに以下のような文字列が入力されます

ここで1点問題があります

半角の空白がStr関数で変換した文字列に入ってしまっています

こちらが気になる場合はCstr関数を使用します

Worksheets(“Sheet1”).Range(“B2”).Value = “A-” & CStr(myVal)

これで空白は入らないようになります

数値への変換

こちらはVal関数を使用します

Dim myVal As String

myVal = “1”

Worksheets(“Sheet1”).Range(“B2”).Value = Val(myVal) + 1

上のコードを実行すると「２」がB2セルに入力されます

数値かどうかの判定

対象の’文字’が数値かどうかの判定は「IsNumeric」を使用します

試しに次のコードを実行してみます

MsgBox IsNumeric(123)

そうすると次の画像のようにTRUEが出力されます

次に以下のコードを実行してみます

MsgBox IsNumeric(“TEST”)

この場合はFALSEが出力されます

注意して頂きたいのは、次の場合はTRUEが出力されます

MsgBox IsNumeric(“１２３”)

これはあくまで１２３が数値文字だからです

メール関連

表をメールの本文に入れる

シート内の表の内容をHTMにするのがポイントです

＊＊＊HTMLの作成＊＊＊

With Worksheets(“MAIL”)

myLast = .Cells(Rows.Count, 2).End(xlUp).Row

For i = 6 To myLast

myProduct = .Cells(i, 2).Value
myQuantity = .Cells(i, 3).Value
myPrice = .Cells(i, 4).Value

myData = myData & “” & “” & myProduct & “” & myQuantity & “” & myPrice & “”

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

そして、作成したHTMLをメールの本文に入れます（メールは送付せず、表示のみにしています）

*正確には事前に見出しを作成しておき、中身を変数で付け加える形です

‘メールの作成

       'OutlookのMailitemオブジェクトを取得する
          Dim objOutlook As New Outlook.Application
          Dim objMailitem As Outlook.MailItem
            Set objMailitem = objOutlook.CreateItem(olMailItem)

        'メールの各種設定をする
           With objMailitem
            .To = "analytic@analytic-vba.com"     '宛先
            '.CC = myCc     'CC
            .Subject = "TEST"
            '.SentOnBehalfOfName = mySenderAddress
            .HTMLBody = "<font face=""遊ゴシック""><font size=""2.5"">" & _
            "<body><table border=1><tr>" & "<th>Product</th><th>Quantity</th><th>Price</th>" & "　　
　　　　　　</tr>" & _
            myData & "</font></table></body>"

            .Display    '新規メール画面を表示

           End With 'objMailitem

これでエクセルシート内の表がメールの本文に入ります

ファイルを添付して送付

.Attachments.Add+ファイル名の一文を上記のコードに追加します

 Dim objMailitem As Outlook.MailItem
 Set objMailitem = objOutlook.CreateItem(olMailItem)
    
 'メールの各種設定をする
 With objMailitem
   .To = "analytic@vba.com"     '宛先
    （省略）
 　.Attachments.Add "C:\Users\＊＊＊\Downloads\download.csv"

   .Display    '新規メール画面を表示

 End With 'objMailitem

ユーザーフォーム

ユーザーフォームについてはこちらの記事もご参考にしてください

処理中表示

マクロの処理に時間がかかる場合は「処理中」の表示をしておきたい場合があります

こちらの表示にはユーザーフォームを使いたいところですが、ユーザーフォームを表示すると後続処理が止まってしまいます

ですので、以下のように「vbModeless」「Repaint」を使用します

Sub test()

UserForm1.Show vbModeless
UserForm1.Repaint

MsgBox “TEST”

Unload UserForm1

End Sub

上記のコードであれば、ユーザーフォームを表示しながらメッセージボックスも表示されます

ファイルの扱い

ファイルパスを指定して開く

Openメソッドを使用します

Dim myFileNameBefore As String

myFileNameBefore = “D:\Copy元.xlsx”

Workbooks.Open myFileNameBefore

ファイルを別名保存（コピー）する

SaveAsメソッドを使用します

Dim myFileNameBefore As String
Dim myFileNameAfter As String

myFileNameBefore = “D:\Copy元.xlsx”
myFileNameAfter = “D:\Copy先.xlsx”

Workbooks.Open myFileNameBefore

ActiveWorkbook.SaveAs Filename:=myFileNameAfter

ActiveSheet.Range(“B2”).Value = “TEST”

重複削除

重複削除を行うにはRemoveDuplicatesを使用します

複数列をキーに重複削除を行う際には、第二引数のArrayの中に列番号を複数指定します

例えば、次の表を「A」「B」の2列で重複削除を行うとします

この場合は、次のようなコードを書きます

Dim myLast As Long ‘最終行

myLast = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

Range(“A1:C” & myLast).RemoveDuplicates (Array(1, 2))

これで次のように削除されます

シート操作

全ページ操作

ファイル内の全シートを一律に操作するには「For Each ~ in ~ Next」構文を使用します

次の画像では、各シートのA1セルに値が入っています

そして、シートB以外はA1セルの値を読んでメッセージを表示するようにします

コードは一度、シート変数：wsTESTを宣言した後に次のように書きます

For Each wsTEST In Worksheets

If wsTEST.Name <> “B” Then

wsTEST.Activate
MsgBox Range(“A1”).Value

End If

ちなみにSheet変数.nameでシート名が取得できます

印刷設定

印刷範囲設定

Dim myLast As Long
‘最終行取得
myLast = Worksheets(“Sheet4”).Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(“Sheet4”).PageSetup

‘印刷範囲設定
.PrintArea = “A1:M” & myLast

End with

全列を全て印刷

Application.PrintCommunication = False
With Worksheets(“Sheet4”).PageSetup
‘*全ての列を印刷
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True