便利なexcelマクロ　メモ

Created: June 13, 2022 8:52 PM

文字を赤に設定

1
2
3
4
5
6
7
8
9
10
11
Sub Macro1()
'
' Macro1 Macro
' 文字を赤に設定
' Keyboard Shortcut: Ctrl+r
'
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End Sub

赤枠

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Macro2()
'
' Macro2 Macro
' 赤枠
'
' Keyboard Shortcut: Ctrl+e
'
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, 95.2940944882, 40.5881889764).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Weight = 2.25
        .Transparency = 0
    End With
End Sub

文字を赤に設定

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro3()
'
' Macro3 Macro
' 背景色黄色設定
' Keyboard Shortcut: Ctrl+y
'
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

下矢印を作成

1
2
3
4
5
6
7
8
9
10
11
12
Sub Macro4()
'
' Macro4 Macro
' ↓を作成
' Keyboard Shortcut: Ctrl+l
'
    Dim tshape As Shape
    With ActiveSheet.Range("D14:E20")
        Set tshape = ActiveSheet.Shapes.AddShape(msoShapeDownArrow, ActiveCell.Left, ActiveCell.Top, 95.2940944882, 50.5881889764)
        tshape.Name = "DownArrow"
    End With
End Sub

リスト値よりシートを作成

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
Sub listToSheet()
'
' Macro5 Macro
' シート自動的に作成
' Keyboard Shortcut: Ctrl+i
'
    Dim i As Long
    Dim Addc As Long
    Dim Addr As Long
    Dim n As Long
    Dim MySheet As Worksheet

    Addc = ActiveCell.Column
    Addr = ActiveCell.Row
    i = 0
    Set MySheet = ActiveSheet

    Do
    n = Addr + i
    If MySheet.Cells(n,Addc) <> "" Then
    Sheets.Add after :=ActiveSheet 
    ActiveSheet.Name = MySheet.Cells(n,Addc).Value
    Else: If MySheet.Cells(n,Addc) = "" Or i > 100 Then Exit Do
    End If
    i = i + 1
    Loop

End Sub