LoginSignup
4
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

@Zibeta

【VBA】XLSTART 個人用マクロ

Last updated at Posted at 2023-02-03

AttachKey

'^:Ctrl
'%:Alt
'+:Shift

Sub auto_open()
'ショートカット割り当て
    Application.OnKey "{F1}", ""                                'F1を押してもヘルプを表示させない
'■■■■■■■■■■
'■  Ctrl + Alt    ■
'■■■■■■■■■■
    'フォント
    Application.OnKey "^%{UP}", "IncreaseFontSize"              'Ctrl + Alt + ↑　フォントサイズ　＋１ポイント
    Application.OnKey "^%{DOWN}", "DecreaseFontSize"            'Ctrl + Alt + ↓　フォントサイズ　－１ポイント
    'セル書式設定
    Application.OnKey "^%{LEFT}", "SwitchVerticalAlignment"     'Ctrl + Alt + ←　縦位置切り替え
    Application.OnKey "^%{RIGHT}", "SwitchHorizontalAlignment"  'Ctrl + Alt + →　横位置切り替え
    'オブジェクト
    Application.OnKey "^%,", "SendSpaheToFront"                 'Ctrl + Alt + ,　 オブジェクトを最前面に移動
    Application.OnKey "^%.", "SendSpaheToBack"                  'Ctrl + Alt + .　 オブジェクトを最背面に移動
    Application.OnKey "^%/", "ChangeShapeSelectMode"            'Ctrl + Alt + /   オブジェクトの選択モード
    Application.OnKey "^%m", "GroupUngroupShape"                'Ctrl + Alt + M   オートシェイプグループ化
    
    'ツール
    Application.OnKey "^%q", "GetWorkSheetNames"                'Ctrl + Alt + Q   シート一覧をInputBoxに表示
    Application.OnKey "^%w", "SetFormatConditions"              'Ctrl + Alt + W   条件付き書式(True→緑、False→赤)
    Application.OnKey "^%a", "SetCursorHome"                      'Ctrl + Alt + A   各シートの選択セルを"A1"に変更
    
    
'■■■■■■■■■■
'■  Ctrl + Shift  ■
'■■■■■■■■■■
    '罫線
    Application.OnKey "^+q", "DrawGrid"                         'Ctrl + Shift + Q　 罫線
    Application.OnKey "^+w", "DrawGridAround"                   'Ctrl + Shift + W　 罫線：枠
    Application.OnKey "^+e", "DeleteGrid"                       'Ctrl + Shift + E　 罫線無し
    Application.OnKey "^+r", "DrawGridTable"                    'Ctrl + Shift + R　 罫線：表
    
    'セル結合
    Application.OnKey "^+a", "CellMergeUnMerge"                 'Ctrl + Shift + A　 選択セルの結合と結合解除
    Application.OnKey "^+s", "MergeUnMergeSide"                 'Ctrl + Shift + S　 選択セルの横方向の結合と結合解除
    
    'セルコピー
    Application.OnKey "^+d", "CopyCellFontWhite"                'Ctrl + Shift + D　 セルコピー + 2行目以降のフォントカラー白
    
    '行／列操作
    Application.OnKey "^+f", "InsertLine"                       'Ctrl + Shift + F 　行挿入
    Application.OnKey "^+g", "InsertLineEachRows"               'Ctrl + Shift + G 　一行置きに行挿入
    Application.OnKey "^+h", "DeleteLine"                       'Ctrl + Shift + H 　行削除
    
    ' オブジェクト
    Application.OnKey "^+z", "AddShapeRectangle"                'Ctrl + Shift + Z 　枠
    Application.OnKey "^+x", "AddShapeConnextor"                'Ctrl + Shift + X   矢印
    Application.OnKey "^+c", "AddShapeCircle"                   'Ctrl + Shift + C   楕円
    Application.OnKey "^+v", "AddShapeCallout"                  'Ctrl + Shift + V 　吹き出し
    
    'フォント
    Application.OnKey "^+1", "SwitchFontColor"                  'Ctrl + Shift + 1　 フォントカラースイッチ 自動/赤/白
    
    'セル バッググラウンドカラー変更
    Application.OnKey "^+2", "SwitchInteriorColor"               'Ctrl + Shift + 2  塗りつぶし：なし
    Application.OnKey "^+3", "'SetBGColor 0'"                    'Ctrl + Shift + 3  塗りつぶし：オレンジ
    Application.OnKey "^+4", "'SetBGColor 1'"                    'Ctrl + Shift + 4  塗りつぶし：青色
    Application.OnKey "^+5", "'SetBGColor 2'"                    'Ctrl + Shift + 5  塗りつぶし：緑色
    Application.OnKey "^+6", "'SetBGColor 3'"                    'Ctrl + Shift + 6  塗りつぶし：黄色
    Application.OnKey "^+7", "'SetBGColor 4'"                    'Ctrl + Shift + 7  塗りつぶし：黒色
    
    
'■■■■■■■■■■■■■
'■  Ctrl + Shift + ALT  ■
'■■■■■■■■■■■■■
    Application.OnKey "^+%r", "基本設計書_ズーム改ページ"
    Application.OnKey "^+%f", "showSearchBox"                    'Ctrl + Shift + Alt + F  検索ボックス表示
    Application.OnKey "^+%l", "ResetFilter"                      'Ctrl + Shift + Alt + l  フィルタの絞り込みを解除
    
End Sub

modCommon

'-------------------------------------------
' 画面更新抑止/イベント発生抑止/関数手動計算
'-------------------------------------------
Public Sub InvalidExcelEvents()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

'-------------------------------------------
' 画面更新抑止解除/イベント発生抑止解除/関数自動計算
'-------------------------------------------
Public Sub ValidExcelEvents()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
'--------------------------------------
'フォルダを選択ダイアログを表示
'選択されたフォルダのフルパスを返却
'--------------------------------------
Public Function FolderPicker()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            FolderPicker = .SelectedItems(1)
        Else
            End
        End If
        
    End With
End Function

modPaste

'■■■■■■■■■■■■■■■■■■■■■
'■  ペースト系
'■■■■■■■■■■■■■■■■■■■■■

'-------------
' 値の貼り付け
'-------------
Sub PasteValue()
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

'-------------
' 書式の貼り付け
'-------------
Sub PasteFormats()
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

'--------------------------
'行列を入れ替えて貼り付け
'--------------------------
Sub PaseteValueRotate()
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

modRange

'■■■■■■■■■■■■■■■■■■■■■
'■  セル
'■■■■■■■■■■■■■■■■■■■■■
Sub CellMergeUnMerge()
'-------------
'セル結合・解除
'-------------
    On Error GoTo MyError
    With Selection
        If .MergeCells = False Then
            .MergeCells = True
        Else
            .MergeCells = False
        End If
    End With
MyError:
End Sub
Sub MergeUnMergeSide()
'-------------
'横方向に結合・解除
'-------------
    On Error GoTo MyError
    With Selection
        If .MergeCells = False Then
            .Merge True
        Else
            .MergeCells = False
        End If
    End With
MyError:
End Sub
Sub CopyTopMergedCellToUnderCell()
'--------------------------------------
'Ctrl + D の結合セル対応版
'--------------------------------------
    Range(Cells(Selection.Row, Selection.Column), Cells(Selection.Row, Selection(Selection.Count).Column)).Copy
    Range(Cells(Selection.Row + 1, Selection.Column), Cells(Selection(Selection.Count).Row, Selection(Selection.Count).Column)).PasteSpecial
    Application.CutCopyMode = False
End Sub

Sub CopyCellFontWhite()
'--------------------------------------
'Ctrl + D の2行目以降のフォントカラー白
'--------------------------------------
    Range(Cells(Selection.Row, Selection.Column), Cells(Selection.Row, Selection(Selection.Count).Column)).Copy
    Range(Cells(Selection.Row + 1, Selection.Column), Cells(Selection(Selection.Count).Row, Selection(Selection.Count).Column)).PasteSpecial
    Range(Cells(Selection.Row + 1, Selection.Column), Cells(Selection(Selection.Count).Row, Selection(Selection.Count).Column)).Font.Color = RGB(255, 255, 255)
    Application.CutCopyMode = False

End Sub

Sub SwitchVerticalAlignment()
'--------------------------------------
'セル縦位置切り替え
'--------------------------------------
    With Selection
        If .VerticalAlignment = xlTop Then
            .VerticalAlignment = xlCenter
        ElseIf .VerticalAlignment = xlCenter Then
            .VerticalAlignment = xlBottom
        Else
            .VerticalAlignment = xlTop
        End If
    End With
End Sub
Sub SwitchHorizontalAlignment()
'--------------------------------------
'セル横位置切り替え
'--------------------------------------
    With Selection
        If .HorizontalAlignment = xlDistributed Then
            .HorizontalAlignment = xlLeft
        ElseIf .HorizontalAlignment = xlLeft Then
            .HorizontalAlignment = xlCenter
        ElseIf .HorizontalAlignment = xlCenter Then
            .HorizontalAlignment = xlRight
        Else
            .HorizontalAlignment = xlDistributed
        End If
    End With
End Sub

Sub SwitchWrapText()
'--------------------------------------
'折り返し表示切り替え
'--------------------------------------
    With Selection
        If .WrapText = True Then
            .WrapText = False
        Else
            .WrapText = True
        End If
    End With
End Sub

'■■■■■■■■■■■■■■■■■■■■■
'■  セル バックグラウンドカラー設定
'■■■■■■■■■■■■■■■■■■■■■
Sub SetBGColor(vKey)
'------------------
'カラーセット入口
'------------------
    Const vDefTandS = 1
    vTandS = vDefTandS
    vTintAndShade = Array(0, 0.4, 0.6)
    vXlThemeColor = Array(xlThemeColorAccent2, xlThemeColorAccent1, xlThemeColorAccent6, xlThemeColorAccent4, xlThemeColorLight1)
    If IsNull(GetBGColorTheme) Or IsNull(GetBGColorTintAndShade) Or (GetBGColorTheme = -4142) Then
        vTandS = vTintAndShade(vDefTandS)
    Else
        If vXlThemeColor(vKey) = GetBGColorTheme Then
            vTandS = TintAndShadeRotate(GetBGColorTintAndShade)
        Else
            vTandS = vTintAndShade(vDefTandS)
        End If
    End If
    Call SetBGColors(vTintAndShade(vTandS), vXlThemeColor(vKey))
End Sub
Sub SetBGColors(vTintAndShade, vXlThemeColor)
'------------------
'選択セルの色セット
'濃度
'テーマ
'------------------
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = vXlThemeColor
        .TintAndShade = vTintAndShade
        .PatternTintAndShade = 0
    End With
End Sub
Function TintAndShadeRotate(vTandS)
'------------------
'濃度ローテート
'------------------
    If vTandS >= 2 Then
        TintAndShadeRotate = 0
    Else
        TintAndShadeRotate = vTandS + 1
    End If
End Function
Function GetBGColorTheme()
'------------------
'選択セルのカラーテーマ取得
'------------------
    With Selection.Interior
        GetBGColorTheme = .ThemeColor
        
    End With
End Function
Function GetBGColorTintAndShade()
'------------------
'選択セルの色濃度取得
'------------------
    vTintAndShade = Array(0, 0.4, 0.6)
    vCelTintAndShade = Selection.Interior.TintAndShade
    For i = 0 To 2
        If Round(vCelTintAndShade, 2) = vTintAndShade(i) Then
            Exit For
        End If
    Next
    GetBGColorTintAndShade = i
End Function

Sub SwitchInteriorColor()
'------------------
'塗りつぶし色切り替え なし→黄色→なし
'------------------
    If Selection.Interior.ColorIndex = xlNone Then
        Selection.Interior.Color = RGB(255, 255, 0)
    Else
        Selection.Interior.ColorIndex = xlNone
    End If
    
End Sub

'■■■■■■■■■■■■■■■■■■■■■
'■  行／列操作
'■■■■■■■■■■■■■■■■■■■■■
Sub InsertLine()
'--------------------------
'行挿入
'--------------------------
    Selection.EntireRow.Insert
End Sub
Sub InsertLineEachRows()
'--------------------------
'一行置きに行挿入
'--------------------------
    For i = Selection(Selection.Count).Row To Selection(1).Row Step -1
        Rows(i + 1).Insert
    Next i
End Sub
Sub DeleteLine()
'--------------------------
'行挿入
'--------------------------
    Selection.EntireRow.DELETE
End Sub
Sub AdjustSelectionRows()
'--------------------------
'選択範囲の行幅を自動調整する
'--------------------------
    For i = Selection(Selection.Count).Row To Selection(1).Row Step -1
        Rows(i + 1).Insert
    Next i
End Sub
'■■■■■■■■■■■■■■■■■■■■■
'■  フォント
'■■■■■■■■■■■■■■■■■■■■■
Sub SwitchFontColor()
'--------------------------------------
'フォント色切り替え 自動→赤色→白色→自動
'--------------------------------------
    If Selection.Font.ColorIndex = xlAutomatic Or Selection.Font.ColorIndex = 1 Then
        Selection.Font.Color = RGB(255, 0, 0)
    ElseIf Selection.Font.ColorIndex = 3 Then
        Selection.Font.Color = RGB(255, 255, 255)
    Else
        Selection.Font.ColorIndex = xlAutomatic
    End If
End Sub
Sub IncreaseFontSize()
'--------------------------------------
'フォントサイズ大きく
'--------------------------------------
    With Selection.Font
        .size = .size + 1
        If .size > 300 Then
            .size = 300
        End If
    End With
End Sub
Sub DecreaseFontSize()
'--------------------------------------
'フォントサイズ小さく
'--------------------------------------
    With Selection.Font
        If .size >= 2 Then
            .size = .size - 1
        End If
    End With
End Sub

modTools


'■■■■■■■■■■■■■■■■■■■■■
'■  ツール
'■■■■■■■■■■■■■■■■■■■■■
Sub SetCursorHome()
'--------------------------------------
'各シートの選択セルを"A1"に変更
'--------------------------------------
    Dim s As Object
    For Each s In ActiveWorkbook.Sheets
        s.Activate
        'SendKeys "^{HOME}"
        Application.GoTo Range("A1"), True
    Next s
    Sheets(1).Select
End Sub

Sub GetWorkSheetNames()
'--------------------------------------
'各シート名をClipboard にコピー
'--------------------------------------
    Dim targetWorkSheet As Worksheet
    Dim workSheetNames As String
    Dim CB As New DataObject
    For Each targetWorkSheet In Sheets
        workSheetNames = workSheetNames & targetWorkSheet.Name & vbCrLf
    Next
    With CB
        .SetText workSheetNames
        .PutInClipboard
    End With
End Sub

modShape


'■■■■■■■■■■■■■■■■■■■■■
'■  オートシェイプ
'■■■■■■■■■■■■■■■■■■■■■
Sub GroupUngroupShape()
'--------------------------
'オートシェイプグループ化・解除
'--------------------------
    Dim sType: sType = TypeName(Selection)
    If sType = "DrawingObjects" Then
        Selection.ShapeRange.Group.Select
    ElseIf sType = "GroupObject" Then
        Selection.ShapeRange.Ungroup.Select
    End If
End Sub

Sub ChangeShapeSelectMode()
'--------------------------
'オブジェクトの選択モードにする
'--------------------------
    With Application.CommandBars.FindControl(id:=182)
        If .State = msoButtonUp Then .Execute
    End With
End Sub
Sub SendSpaheToFront()
'--------------------------
'オートシェイプを最前面に移動する
'--------------------------
    Dim sType: sType = TypeName(Selection)
    If sType <> "Range" Then
        Selection.ShapeRange.ZOrder msoBringToFront
    End If
End Sub
Sub SendSpaheToBack()
'--------------------------
'オートシェイプを最背面に移動する
'--------------------------
    Dim sType: sType = TypeName(Selection)
    If sType <> "Range" Then
        Selection.ShapeRange.ZOrder msoSendToBack
    End If
End Sub
Sub AddShapeCallout()
'--------------------------------------
'オートシェイプ：吹き出しを追加
'--------------------------------------
    Dim MyShape As Shape
    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, 1, 1, 180, 54)
    With MyShape.Fill
         .Visible = msoTrue
         .ForeColor.RGB = RGB(255, 255, 255)
         .Transparency = 0
         .Solid
     End With
     With MyShape.TextFrame2.TextRange.Font
         .Fill.Visible = msoTrue
         .Fill.ForeColor.RGB = RGB(0, 0, 0)
         .Name = "Meiryo UI"
         .NameFarEast = "Meiryo UI"
         .NameComplexScript = "Meiryo UI"
         .Fill.Transparency = 0
         .Fill.Solid
     End With
     With MyShape.Line
         .Visible = msoTrue
         .ForeColor.RGB = RGB(255, 0, 0)
         .Transparency = 0
     End With
     With MyShape.TextFrame
         .HorizontalAlignment = xlGeneral
         .VerticalAlignment = xlVAlignCenter
     End With
     With MyShape.Adjustments
        .Item(1) = -0.66596
        .Item(2) = 0.48952
    End With
    With MyShape
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
    End With
End Sub

Sub AddShapeCircle()
'--------------------------------------
'オートシェイプ：楕円を追加
'--------------------------------------
    Dim MyShape As Shape
    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeOval, 1, 1, 60, 30)
    MyShape.Fill.Visible = msoFalse
    With MyShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With MyShape
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
    End With
End Sub

Sub AddShapeRectangle()
'--------------------------------------
'オートシェイプ：楕円を追加
'--------------------------------------
    Dim MyShape As Shape
    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1, 1, 110, 30)
    MyShape.Fill.Visible = msoFalse
    With MyShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With MyShape
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
    End With
End Sub

Sub AddShapeConnextor()
'--------------------------------------
'オートシェイプ：矢印を追加
'--------------------------------------
    Dim MyShape As Shape
    Set MyShape = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 1, 1, 70, 50)
    MyShape.Fill.Visible = msoFalse
    With MyShape.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Weight = 1.25
        .EndArrowheadStyle = msoArrowheadTriangle
    End With
    With MyShape
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
    End With
End Sub

Utils


'--------------------------------------
'最終行を取得(xlDown)
'--------------------------------------
Public Function GetEndRowXLDOWN(ByVal aSheetName As String, ByVal aCol As Long, ByVal aRow) As Long
    GetEndRow = Worksheets(aSheetName).Cells(aRow, aCol).End(xlDown).Row
    If GetEndRow < aMinRow Then
        GetEndRow = aMinRow
    End If
End Function
'--------------------------------------
'最終行を取得(xlUp)
'--------------------------------------
Public Function GetEndRowXLUP(ByVal aSheetName As String, ByVal aCol As Long, Optional ByVal aMinRow As Long = 1) As Long
    GetEndRow = Worksheets(aSheetName).Cells(Rows.Count, aCol).End(xlUp).Row
    If GetEndRow < aMinRow Then
        GetEndRow = aMinRow
    End If
End Function
'--------------------------------------
'1列目からパラメータ列までの列幅を取得
'--------------------------------------
Public Function GetTotalColumnWidth(ByVal aSheetName As String, ByVal aCol As Long) As Double
    Dim TotalColumnWidth As Double
    For i = 1 To aCol
        TotalColumnWidth = TotalColumnWidth + Worksheets(aSheetName).Columns(i).ColumnWidth
    Next
    GetTotalColumnWidth = TotalColumnWidth
End Function
'--------------------------------------
'1列目からパラメータ列までの列幅を取得(単位：ピクセル)
'--------------------------------------
Public Function GetTotalColumnWidthPixel(ByVal aSheetName As String, ByVal aCol As Long) As Double
    Dim TotalColumnWidthPixel As Double
    For i = 1 To aCol
        TotalColumnWidthPixel = TotalColumnWidthPixel + Worksheets(aSheetName).Columns(i).width
    Next
    GetTotalColumnWidthPixel = TotalColumnWidthPixel
End Function
'--------------------------------------
'1行目からパラメータ行までの行幅を取得
'--------------------------------------
Public Function GetTotalRowHeight(ByVal aSheetName As String, ByVal aRow As Long)
    Dim TotalRowHeight As Double
    For i = 1 To aRow
        TotalRowHeight = TotalRowHeight + Worksheets(aSheetName).Rows(i).RowHeight
    Next
    GetTotalRowHeight = TotalRowHeight

End Function
'--------------------------------------
'セルが選択されているかどうかを判定する
'true:セルが選択されている
'false:セルが選択されていない
'--------------------------------------
Public Function isCell(aSelection) As Boolean
    Dim sType: sType = TypeName(aSelection)
    If (sType <> "Range") Then
        isCell = False
        Exit Function
    End If
    isCell = True
End Function

'-------------------------------------------
' Null/Emptyチェック
' @param sVal チェック対象文字列
' @return Null/Emptyの場合はTrue
'-------------------------------------------
Public Function IsNullOrEmpty(ByVal sVal As Variant) As Boolean
    If IsNull(sVal) Or IsEmpty(sVal) Or sVal = "" Then IsNullOrEmpty = True
End Function
'-------------------------------------------
' パラメータ文字列の両端にシングルクォーテーション付与
' @param sVal 文字列
' @return '文字列'
'-------------------------------------------
Public Function AttachSinglequotation(ByVal sVal As String) As String
    AttachSinglequotation = Chr(39) & sVal & Chr(39)
End Function
'-------------------------------------------
' パラメータ文字列の両端にダブルクォーテーション付与
' @param sVal 文字列
' @return "文字列"
'-------------------------------------------
Public Function AttachDoublequotation(ByVal sVal As String) As String
    AttachDoublequotation = Chr(34) & sVal & Chr(34)
End Function
'-------------------------------------------
' パラメータ文字列の両端に括弧付与
' @param sVal 文字列
' @return (文字列)
'-------------------------------------------
Public Function AttachBrackets(ByVal sVal As String) As String
    AttachBrackets = Chr(40) & sVal & Chr(41)
End Function

modGrid

'■■■■■■■■■■■■■■■■■■■■■
'■  罫線
'■■■■■■■■■■■■■■■■■■■■■

'-------------
'罫線
'-------------
Sub DrawGrid()
    Selection.Borders.LineStyle = xlContinuous
End Sub

'-------------
'罫線無し
'-------------
Sub DeleteGrid()
    Selection.Borders.LineStyle = xlLineStyleNone
End Sub

'-------------
'罫線:枠
'-------------
Sub DrawGridAround()
    Selection.BorderAround Weight:=xlThin, ColorIndex:=1
End Sub

'-------------
'罫線:表
'-------------
Sub DrawGridTable()
    Selection.Borders.LineStyle = xlContinuous
    With Selection.Rows(1).Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
    End With
End Sub
4
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
4
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?