JPG, PNG, Code, 説明文のテスト

ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文

以下のこれはJPG

JPGです

ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文

これはPNG

ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文 ここに説明文

Option Explicit

'Check1_AとCheck1_Bはチェックボックス
'Check1_AとCheck1_Bは同じグループにあるが、それぞれは独立してON/OFFできる
'それぞれのチェックボックスは、それぞれクリックしてTRUEになったとき、カラーになる
'FALSEになったとき、ホワイトに戻る

                        Private Sub Check1_A_Change()

                                        If Check1_A.Value Then
                                                Range("J4") = "TRUE"
                                                Range("Check1_A").Interior.Color = RGB(255, 153, 153)
                                                Check1_A.BackColor = RGB(255, 153, 153)
                                        Else
                                                Range("J4") = "FALSE"
                                                Range("Check1_A").Interior.Color = RGB(255, 255, 255)
                                                Check1_A.BackColor = RGB(255, 255, 255)
                                                
                                        End If
                        End Sub
                        
                        Private Sub Check1_B_Change()

                                        If Check1_B.Value Then
                                                Range("K4") = "TRUE"
                                                Range("Check1_B").Interior.Color = RGB(102, 255, 102)
                                                Check1_B.BackColor = RGB(102, 255, 102)
                                        Else
                                                Range("K4") = "FALSE"
                                                Range("Check1_B").Interior.Color = RGB(255, 255, 255)
                                                Check1_B.BackColor = RGB(255, 255, 255)
                                        End If
                        End Sub
                        
'Button1_OKとButton1_NGはラジオボタン
'Button1_OKとButton1_NGは同じグループにあって、どちらか一方だけがTRUEになる

'このどちらかのボタンがTRUEになったとき、そのボタンのボックスがカラーになり、もう片方はFALSEになってホワイトになる

                        Private Sub Button1_OK_Change()

                                        If Button1_OK.Value Then
                                                Range("J10") = "TRUE"
                                                Range("Button1_OK").Interior.Color = RGB(153, 255, 204)
                                                Button1_OK.BackColor = RGB(153, 255, 204)
                                        Else
                                                Range("J10") = "FALSE"
                                                Range("Button1_OK").Interior.Color = RGB(255, 255, 255)
                                                Button1_OK.BackColor = RGB(255, 255, 255)
                                        End If
                        End Sub
                        
                        Private Sub Button1_NG_Change()

                                        If Button1_NG.Value Then
                                                Range("K10") = "TRUE"
                                                        Range("Button1_NG").Interior.Color = RGB(255, 204, 153)
                                                        Button1_NG.BackColor = RGB(255, 204, 153)
                                        Else
                                                Range("K10") = "FALSE"
                                                        Range("Button1_NG").Interior.Color = RGB(255, 255, 255)
                                                        Button1_NG.BackColor = RGB(255, 255, 255)
                                        End If
                        End Sub

Option Explicit
‘Check1_AとCheck1_Bはチェックボックス
‘Check1_AとCheck1_Bは同じグループにあるが、それぞれは独立してON/OFFできる
‘それぞれのチェックボックスは、それぞれクリックしてTRUEになったとき、カラーになる
‘FALSEになったとき、ホワイトに戻る
Private Sub Check1_A_Change() If Check1_A.Value Then Range("J4") = "TRUE" Range("Check1_A").Interior.Color = RGB(255, 153, 153) Check1_A.BackColor = RGB(255, 153, 153) Else Range("J4") = "FALSE" Range("Check1_A").Interior.Color = RGB(255, 255, 255) Check1_A.BackColor = RGB(255, 255, 255) End If End Sub Private Sub Check1_B_Change() If Check1_B.Value Then Range("K4") = "TRUE" Range("Check1_B").Interior.Color = RGB(102, 255, 102) Check1_B.BackColor = RGB(102, 255, 102) Else Range("K4") = "FALSE" Range("Check1_B").Interior.Color = RGB(255, 255, 255) Check1_B.BackColor = RGB(255, 255, 255) End If End Sub
‘Button1_OKとButton1_NGはラジオボタン
‘Button1_OKとButton1_NGは同じグループにあって、どちらか一方だけがTRUEになる
‘このどちらかのボタンがTRUEになったとき、そのボタンのボックスがカラーになり、もう片方はFALSEになってホワイトになる
Private Sub Button1_OK_Change() If Button1_OK.Value Then Range("J10") = "TRUE" Range("Button1_OK").Interior.Color = RGB(153, 255, 204) Button1_OK.BackColor = RGB(153, 255, 204) Else Range("J10") = "FALSE" Range("Button1_OK").Interior.Color = RGB(255, 255, 255) Button1_OK.BackColor = RGB(255, 255, 255) End If End Sub Private Sub Button1_NG_Change() If Button1_NG.Value Then Range("K10") = "TRUE" Range("Button1_NG").Interior.Color = RGB(255, 204, 153) Button1_NG.BackColor = RGB(255, 204, 153) Else Range("K10") = "FALSE" Range("Button1_NG").Interior.Color = RGB(255, 255, 255) Button1_NG.BackColor = RGB(255, 255, 255) End If End Sub

Outlookの練習

Option Explicit

Sub SendBasicEmailEarlyBinding()
‘Microsoft Outlook 16.0 libraryを early bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略
Dim olApp As Outlook.Application

    Set olApp = New Outlook.Application

End Sub

Sub SendBasicEmailLateBinding()
‘Microsoft Outlook 16.0 libraryを Late bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略
Dim olApp As Object

    Set olApp = CreateObject("Outlook.Application")

End Sub

Sub SendBasicEmail()
‘Microsoft Outlook 16.0 libraryを early bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略

    'このあたりのdimやsetはもう丸覚えしかない
    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    olEmail.Display
    'これで、outlookを起動して、ブランクのemailウィンドゥが開かれる

End Sub

Sub SendBasicEmail2()
‘Microsoft Outlook 16.0 libraryを early bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略

    'このあたりのdimやsetはもう丸覚えしかない
    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    With olEmail
                    .BodyFormat = olFormatHTML
                    .Display
            .HTMLBody = "<H1>Dear Someone</H1>"
            'displayしてもしなくてもよい

‘ .Display
.To = “akijsaito@mac.com”
.Subject = “Movie Report”

‘ .BodyFormat = olFormatPlain
‘ .BodyFormat = olFormatRichText
‘ .Body = “Dear someone”
‘HTMLbodyでは、タグが書ける
‘.Sendで一気に送信
.Send

    End With

End Sub

Sub SendBasicEmail_Attachement()
‘Microsoft Outlook 16.0 libraryを early bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略

    'このあたりのdimやsetはもう丸覚えしかない
    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    With olEmail
                    .BodyFormat = olFormatHTML
                    .Display
            .HTMLBody = "<H1>Dear Someone</H1>"

‘ .Attachments.Add “c:\users\akishige saito\documents\book1.xlsm”
‘Environ(“UserProfile”) で、”c:\users\akishige saito”を得ることができる
.Attachments.Add Environ(“UserProfile”) & “\documents\book1.xlsm”
‘displayしてもしなくてもよい
‘ .Display
.To = “akijsaito@mac.com”
.Subject = “Movie Report”

‘ .BodyFormat = olFormatPlain
‘ .BodyFormat = olFormatRichText
‘ .Body = “Dear someone”
‘HTMLbodyでは、タグが書ける
‘.Sendで一気に送信
‘ .Send

    End With

End Sub

Sub SendBasicEmail_Attachement_LateBinding()
‘Microsoft Outlook 16.0 libraryを late bindingする
‘Microsoft Outlook 16.0 libraryのlate bindingは、なかなか面倒なことが多い
‘Outlookは、このようにdimするしかない。理由はここでは省略

    'このあたりのdimやsetはもう丸覚えしかない
    Dim olApp As Object
    Dim olEmail As Object

    Set olApp = CreateObject("Outlook.Application")
    Set olEmail = olApp.CreateItem(0)

    With olEmail
                    .BodyFormat = 2
                    .Display
            .HTMLBody = "<H1>Dear Someone</H1>"

‘ .Attachments.Add “c:\users\akishige saito\documents\book1.xlsm”
‘Environ(“UserProfile”) で、”c:\users\akishige saito”を得ることができる
.Attachments.Add Environ(“UserProfile”) & “\documents\book1.xlsm”
‘displayしてもしなくてもよい
‘ .Display
.To = “akijsaito@mac.com”
.Subject = “Movie Report”

‘ .BodyFormat = olFormatPlain
‘ .BodyFormat = olFormatRichText
‘ .Body = “Dear someone”
‘HTMLbodyでは、タグが書ける
‘.Sendで一気に送信
‘ .Send

    End With

End Sub

Sub SendComplexEmail()
‘Microsoft Outlook 16.0 libraryを early bindingする
‘Outlookは、このようにdimするしかない。理由はここでは省略

    'このあたりのdimやsetはもう丸覚えしかない
    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    With olEmail
            .BodyFormat = olFormatPlain
            .Display

            .Body = "Dear Someone" & vbNewLine & vbNewLine & GetMovieData & .Body

            .To = "akijsaito@mac.com"
            .Subject = "Movie Report"
    End With

End Sub

Function GetMovieData() As String
‘これは面白い。どこかで役に立つ

    Dim FilmColumn As Range, FilmRow As Range, r As Range, c As Range
    Dim str As String

    Sheet1.Activate
    Set FilmRow = Range("A2", Range("A1").End(xlDown))

    For Each r In FilmRow   '全部の行をスイープする
            Set FilmColumn = Range(r, r.End(xlToRight))
                    For Each c In FilmColumn        '全部のカラムをスイープする
                            str = str & c.Value

                            '最後のカラムのあとにvbtabを入れないようにするため
                            If c.Column < r.End(xlToRight).Column Then
                                    str = str & vbTab
                            End If

                    Next c

                    '最後の行のあとにvbnewlineを入れないようにするため
                    If r.Row < Range("A1").End(xlDown).Row Then
                            str = str & vbNewLine
                    End If
    Next r

    GetMovieData = str

End Function