2015-09-17 2 views
0

Я новичок в 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 

Picture

ответ

1

Извинения, если я упрощаю вашу проблему, но вы не просто нужно сделать следующее:

If Len(Cell3Text) = 6 And receiptsImg <> "" Then 

    count=0'Reset the counter for a new matching cell 

    While receiptsImg <> "" 
     count = count + 1 
     ... 
    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 
+0

Большое спасибо. Теперь, когда я узнал, что решение очень простое. Мне стыдно. –

+0

Добро пожаловать! Не могли бы вы пометить ответ как принятый, если у вас появится шанс? В – Ben

Смежные вопросы