Убедитесь, что символ формы не отображается в указанном диапазоне

Question

У меня есть лист, где овальные объекты добавляются с помощью командной кнопки.Каждый раз, когда нажимается командная кнопка, к овалу добавляется назначенный символ.Первому овалу присваивается символ «1», второму «2», третьему «3» и т. Д.

Иногда овал удаляется случайно.Как только это происходит, этот персонаж теряется.Например, скажем, командная кнопка была нажата 5 раз.Теперь есть 5 овалов с 1-5 в каждом.Если овал "2" удален, командная кнопка не может распознать, что этот номер был удален, и, таким образом, при повторном нажатии добавляет овал "6" вместо повторного добавления овала "2"

У меня естьдиапазон ячеек, который добавляет информацию для каждого добавляемого овала.Например, как только овал 1 добавлен, строка 1 заполняется различной информацией, включая символ внутри этого овала.Ряд 2 заполняется информацией о овале 2 и так далее.

Даже если овальная «2» удаляется, ее информация сохраняется в таблице (специально).Я попытался создать циклы, которые перекрестно ссылаются на диапазон таблицы и символы в каждой существующей овальной форме, чтобы, если значение строки не имело формы, система знала, что она должна сначала добавить этот отсутствующий символ овальной формы.

Sub VerifyTable()
Dim WeldNoRange As Range
Dim Cell As Range
Dim shp As Shape
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set WeldNoRange = ws.Range("A6:A76")
'If numbered oval shape doesn't exist, re-add that shape
For Each Cell In WeldNoRange
    If Cell.Value <> vbNullString Then
        For Each shp In ws.Shapes
            If shp.AutoShapeType = msoShapeOval Then
                If CInt(shp.TextFrame.Characters.Text) = Cell.Value Then
                    Exit Sub 'Meaning that this weld no. does in fact have a weld indication
                Else
                    customweld = True
                        UserForm6_Help.Tag = "null"
                    n = CInt(shp.TextFrame.Characters.Text)
                    Exit Sub
                End If
            End If
        Next
    End If
Next

End Sub

Проблема с моим решением заключается в том, что оно недостаточно явное.Скажем, овал "2" отсутствует ... Как только Cell.Value = "4", он проверяет все фигуры в порядке от 1-4.Как только он видит, что овальному «1» назначен символ «1», он интерпретирует этот CInt (shp.TextFrame.Characters.Text) <> Cell.Value, то есть он думает, что овального «4» не существует, когда он на самом деледелает.

Каковы мои варианты решения этой проблемы?

----> Отредактировано, чтобы я мог показать, что было реализовано ...

Sub AddMissingShape()
Dim WeldNoRange As Range, wb As Workbook, ws As Worksheet
Dim Cell As Range
Dim shp As Shape, s As Shape, b As Boolean

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set WeldNoRange = ws.Range("A6:A76")

For Each Cell In WeldNoRange
    If Cell.Value <> vbNullString Then
        If Cell.Value > 0 Then
            For Each shp In ws.Shapes
                If shp.AutoShapeType = msoShapeOval Then
                    If CInt(shp.TextFrame.Characters.Text) = Cell.Value Then
                        b = True
                        Exit For
                    Else
                        b = False
                    End If
                End If
            Next

        End If
        If Not b Then    
        Set s = ws.Shapes.AddShape(msoShapeOval, 100, 100, 100, 100) '100s just for the sake of this solution. Not relevant to this question. 
        s.TextFrame.Characters.Text = Cell.Value
        'Here I have a bunch of other "s." identifiers for shape customization. Not relevant to this question. 
        missingshapeadded = True
        Exit Sub
        End If
    End If
Next
missingshapeadded = False
End Sub

Логическое значениепеременная missingshapeadded используется в моем Sheet1> CommandButton.После нажатия моей CommandButton,

Call CountShapes     'Counts actual number of shapes
Call AddMissingShape   'Adds missing shape if applicable
If missingshapeadded = True Then
    Exit Sub
End If
Call AddShape        'Adds shape based on number of shapes present
Call FillTableRow    'Fills table row based on shape number

Если missingshapeadded = true, мои отдельные подпрограммы AddShape и FillTable не вызываются.Если false, эти два вызывают, таким образом добавляя новую форму со следующим индексированным числом.

Answer 1

Как и @SJR, я не совсем понимаю, что вы пытаетесь сделать, но, возможно, следующее поможет вам найти значение следующего овала, который будет добавлен:

Sub Test()

Dim x As Long
Dim ArrL As Object: Set ArrL = CreateObject("System.Collections.ArrayList")

For Each shp In Sheet1.Shapes 'Change sheet codename accordingly
    If shp.AutoShapeType = msoShapeOval Then
        ArrL.Add CLng(shp.TextFrame.Characters.Text)
    End If
Next shp

ArrL.Sort
x = 1
For Each Item In ArrL
    If Item > x Then
        Exit For
    Else
        x = x + 1
    End If
Next Item

Debug.Print "First in line is " & x

End Sub

Если бы вы реализоваличто в объекте Range вы можете сообщить своему макросу, что, например, овал в WeldNoRange.Cells(x,1) отсутствует и должен быть добавлен.

Answer 2

Детали того, что вы пытаетесь сделать, мне не совсем понятны, но это может помочь.

Я поместил числа 1-4 в A6: A9 и добавил три овала с именами 1, 2и 4. После запуска кода он добавляет овал, содержащий 3 (называемый «овал 3»).

Не ясно, хотите ли вы, чтобы этот саб добавлял фигуру, но если нет, вы могли бы вызвать другой сабвуфер к этомубит?

Sub VerifyTable()

Dim WeldNoRange As Range, wb As Workbook, ws As Worksheet
Dim Cell As Range
Dim shp As Shape, s As Shape, b As Boolean

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set WeldNoRange = ws.Range("A6:A9")

For Each Cell In WeldNoRange
    If Cell.Value <> vbNullString Then
        For Each shp In ws.Shapes
            If shp.AutoShapeType = msoShapeOval Then
                If CInt(shp.TextFrame.Characters.Text) = Cell.Value Then
                    b = True
                    Exit For
                End If
            End If
        Next
        If Not b Then
            Set s = ws.Shapes.AddShape(msoShapeOval, 100, 20, 20, 30)
            s.TextFrame.Characters.Text = Cell.Value
           s.Name = "Oval " & Cell.Value
        End If
    End If
    b = False
Next

End Sub