---
title: 自動Ink Circle程式
tags: Code,Excel,VBA
description:
---
{%hackmd theme-dark %}

Public Sub Guard_Bank_Ink()
    Dim NumOfCircle As Variant
    Dim intX, intY, intCenterX, intCenterY As Integer
    Dim strPN As String
    Dim i, j, k, m As Long
    Dim intCoorX, intCoorY As Integer
    Dim intCoorX2, intCoorY2 As Integer
    Dim intCoorXLast, intCoorYLast As Integer
        
    strPN = Sheets("MapFileName").Cells(2, 2).Value
    intX = Sheets("MapFileName").Cells(4, 2).Value
    intY = Sheets("MapFileName").Cells(5, 2).Value
    intCenterX = Round(intX \ 2)
    intCenterY = Round(intY \ 2)
    
    If Not GetXMLvariable(Sheets("MapFileName").Cells(9, 2).Value, True) Then Exit Sub
    
    ActiveSheet.Unprotect ("password")
    If xmlVariable.Var(21) = "TI" Then
        NumOfCircle = Trim(InputBox("Please Input Number Of Circle?", "Guard Bank Ink"))
        If IsEmpty(NumOfCircle) Or Not IsNumeric(NumOfCircle) Then Exit Sub
        'First Quadrant
        For k = 1 To CInt(NumOfCircle)
            For i = intCenterY - 1 To 1 Step -1
                Sheets("MAP").Select
                Range(Cells(i + 2, 1 + 1), Cells(i + 2, intX + 1)).Select
                For j = intX To intCenterX + 2 Step -1
                    intCoorY = i + 2
                    intCoorX = j + 1
                    intCoorYLast = intCoorY
                    intCoorXLast = intCoorX
                    Sheets("Map").Cells(intCoorY, intCoorX).Select

                    If Sheets("Map").Cells(intCoorY, intCoorX).Value = "" And Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 2 Then 'white
                        Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 3
                        For m = intCoorX To intCenterX + 2 Step -1
                            intCoorY2 = intCoorY
                            intCoorX2 = m
                            Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Select
                            If Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Value <> "" Or Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Interior.ColorIndex <> 2 Then
                                If intCoorX2 >= intCoorXLast Then
                                    Sheets("Map").Cells(intCoorY2, intCoorX2 - 1).Interior.ColorIndex = 3
                                    intCoorYLast = intCoorY2
                                    intCoorXLast = intCoorX2 - 1
                                End If

                            End If
                        Next

                        Exit For
                    End If
                Next
            Next
        Next
        
        'Second Quadrant
        For k = 1 To CInt(NumOfCircle)
            For i = intCenterY - 1 To 1 Step -1
                 For j = 1 To intCenterX - 1
                    intCoorY = i + 2
                    intCoorX = j + 1
                    intCoorYLast = intCoorY
                    intCoorXLast = intCoorX
                    Sheets("Map").Cells(intCoorY, intCoorX).Select

                    If Sheets("Map").Cells(intCoorY, intCoorX).Value = "" And Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 2 Then 'white
                        Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 3
                        For m = intCoorX To intCenterX - 1
                            intCoorY2 = intCoorY
                            intCoorX2 = m
                            Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Select
                            If Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Value <> "" Or Sheets("Map").Cells(intCoorY2 - 1, intCoorX2).Interior.ColorIndex <> 2 Then
                                If intCoorX2 <= intCoorXLast Then
                                    Sheets("Map").Cells(intCoorY2, intCoorX2 + 1).Interior.ColorIndex = 3
                                    intCoorYLast = intCoorY2
                                    intCoorXLast = intCoorX2 + 1
                                End If
                            End If
                        Next

                        Exit For
                    End If
                 Next
            Next
        Next
        
        'Third Quadrant
        For k = 1 To CInt(NumOfCircle)
            For i = intCenterY To intY
                For j = 1 To intCenterX - 1
                    intCoorY = i + 2
                    intCoorX = j + 1
                    intCoorYLast = intCoorY
                    intCoorXLast = intCoorX
                    Sheets("Map").Cells(intCoorY, intCoorX).Select

                    If Sheets("Map").Cells(intCoorY, intCoorX).Value = "" And Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 2 Then 'white
                        Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 3

                        For m = intCoorX To intCenterX - 1
                            intCoorY2 = intCoorY
                            intCoorX2 = m
                            Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Select
                            If Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Value <> "" Or Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Interior.ColorIndex <> 2 Then
                                If intCoorX2 <= intCoorXLast Then
                                    Sheets("Map").Cells(intCoorY2, intCoorX2 + 1).Interior.ColorIndex = 3
                                    intCoorYLast = intCoorY2
                                    intCoorXLast = intCoorX2 + 1
                                End If
                            End If
                        Next

                        Exit For
                    End If
                Next
            Next
        Next
        
        'Four Quadrant
        For k = 1 To CInt(NumOfCircle)
            For i = intCenterY To intY
                For j = intX To intCenterX + 1 Step -1
                    intCoorY = i + 2
                    intCoorX = j + 1
                    intCoorYLast = intCoorY
                    intCoorXLast = intCoorX
                    Sheets("Map").Cells(intCoorY, intCoorX).Select

                    If Sheets("Map").Cells(intCoorY, intCoorX).Value = "" And Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 2 Then 'white
                        Sheets("Map").Cells(intCoorY, intCoorX).Interior.ColorIndex = 3
                        For m = intCoorX To intCenterX + 1 Step -1
                            intCoorY2 = intCoorY
                            intCoorX2 = m
                            Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Select
                            If Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Value <> "" Or Sheets("Map").Cells(intCoorY2 + 1, intCoorX2).Interior.ColorIndex <> 2 Then
                                If intCoorX2 >= intCoorXLast Then
                                    Sheets("Map").Cells(intCoorY2, intCoorX2 - 1).Interior.ColorIndex = 3
                                    intCoorYLast = intCoorY2
                                    intCoorXLast = intCoorX2 - 1
                                End If
                            End If
                        Next

                        Exit For
                    End If
                Next
            Next
        Next
        
    End If
    ActiveSheet.Protect ("password")
End Sub