投稿‎ > ‎

oneclickでマーク

posted Aug 20, 2018, 6:24 PM by Zhang Wenxu

Sub mark()
'
' mark Macro
'

'
    Dim left
    Dim top
   
    If VarType(Selection) = vbObject Then
        left = Selection.ShapeRange(1).left
        top = Selection.ShapeRange(1).top
    Else
        left = ActiveCell.left
        top = ActiveCell.top
    End If
    ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, left, top, 82.5, _
        69.1666929134).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With Selection.ShapeRange.line
        .Visible = msoTrue
        .Weight = 2.25
    End With
   
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.text = "初期のエラーコードがない"
   
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
End Sub

Sub markCell()
'
' Macro1 Macro
'
'
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
End Sub

Sub markRect()
'
' markRect Macro
'
'
    Dim left
    Dim top
   
    If VarType(Selection) = vbObject Then
        left = Selection.ShapeRange(1).left
        top = Selection.ShapeRange(1).top
    Else
        left = ActiveCell.left
        top = ActiveCell.top
    End If
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, left, top, 141, 18).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    With Selection.ShapeRange.line
        .Visible = msoTrue
        .Weight = 2.25
    End With
    With Selection.ShapeRange.line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End Sub

Comments