Я новичок в VBA. Я создаю программу, которая будет прикреплять изображение в соответствии со значением третьего Cell
таблицы (Cell3Text
). Cell3Text
соответствует имени файла изображений в папке «images». Например, 15-001 на первых строк имеет 15-001r1.jpg, 15-001r2.jpg, 15-001r3.jpg, .. и так далее. Каждая строка имеет различное количество файлов изображений (* r1, * r2, * r3).Как сбросить счетчик циклов для каждой строки?
У меня есть счетчик файлов с использованием цикла здесь. Но в следующей строке счетчик добавляет к счету предыдущей строки. Как я могу сбросить счетчик циклов для каждой строки?
Sub ContinuousCounter()
Set tbl = ActiveDocument.Tables(1)
Dim Cell3Text As String
Dim Cell1Text As String
Dim imgDir As String
Dim receiptsImg As String
Dim count As Integer
For Idx = tbl.Rows.count To 1 Step -1
tbl.Cell(Idx, 1).Range.Select
Cell3Text = tbl.Cell(Idx, 3)
Cell3Text = Left$(Cell3Text, Len(Cell3Text) - 2) ' Remove table cell markers from the text.
Cell1Text = tbl.Cell(Idx, 1)
Cell1Text = Left$(Cell1Text, Len(Cell1Text) - 2) ' Remove table cell markers from the text.
imgDir = ActiveDocument.path & "\images\"
receiptsImg = Dir(imgDir & Cell3Text & "r*.jpg")
Selection.EndKey Unit:=wdRow, Extend:=True
Selection.MoveRight Unit:=wdCharacter, count:=2
If Len(Cell3Text) = 6 And receiptsImg <> "" Then
While receiptsImg <> ""
count = count + 1
Selection.TypeText Text:=Chr(11)
Selection.InlineShapes.AddPicture _
FileName:=imgDir & receiptsImg, _
LinkToFile:=False, SaveWithDocument:=True
Selection.TypeText Text:=Chr(11)
' Get next file name.
receiptsImg = Dir()
Wend
MsgBox count 'debugger only. shows the number of files containing "r" according to 3rd cell in a row
' but seems every loop adds to the previous count
Else
MsgBox "No scanned image for " & Cell3Text & ". otherwise it is improperly renamed."
End If
' ::::::::::::::::::::::::::::::::BREAK ROWS::::::::::::::::::::::::::::::::::::::::
If Len(Cell3Text) < 2 Then ' if the 3rd cell is blank then turns into header
tbl.Cell(Idx, 1).Select
Selection.Rows.Delete
Selection.InsertBreak Type:=wdColumnBreak ' or Type:=wdPageBreak
Selection.TypeText Cell1Text
Else
tbl.Cell(Idx, 1).Select
Selection.Cells.Delete
Selection.InsertBreak Type:=wdColumnBreak ' or Selection.SplitTable
End If
Next
End Sub
Большое спасибо. Теперь, когда я узнал, что решение очень простое. Мне стыдно. –
Добро пожаловать! Не могли бы вы пометить ответ как принятый, если у вас появится шанс? В – Ben