Найти строку в таблице VBA Powerpoint - PullRequest
Новая
       26

Найти строку в таблице VBA Powerpoint

0 голосов
/ 04 июля 2018

После 2 дней, пытаясь найти решение моей проблемы, мне нужна ваша помощь, пожалуйста. Я работаю над сценарием PowerPoint VBA, и у меня есть таблица (3,3). В строке 1 я уже ввел некоторую строку в ячейки.

Я хочу знать, почему мой скрипт не хочет писать NOK в ячейках, когда строка не соответствует "comp", например

Вот мой сценарий VBA: 

Public Sub CreateTable1()
' déclaration of variables
Dim objSld As Slide
Dim objShp As Shape
Dim foundText1 As Object
Dim FindWhat As String
Dim I As Integer
Dim j As Integer

Set objSld = ActivePresentation.Slides(1)
Set objShp = objSld.Shapes.AddTable(3, 3, 15, 150, 700, 500)

' Give a name to table
objShp.Name = "Table1"

' Define size of cells
With objSld.Shapes("Table1").Table
    .Columns(1).Width = 115
    .Columns(2).Width = 115
    .Columns(3).Width = 115
    .Rows(1).Height = 120
    .Rows(2).Height = 120
    .Rows(3).Height = 120

    'Write in cells
    With .Cell(1, 1).Shape.TextFrame
        .TextRange.Text = "Composition"
    End With
    With .Cell(2, 1).Shape.TextFrame
        .TextRange.Text = "Material"
    End With
    With .Cell(3, 1).Shape.TextFrame
        .TextRange.Text = "Method"
    End With

' Define text position
    For I = 1 To 3
        For j = 1 To 3
            With .Cell(j, I).Shape.TextFrame
                .VerticalAnchor = msoAnchorMiddle
                .HorizontalAnchor = msoAnchorCenter
                .TextRange.Font.Size = 18
            End With
        Next j
    Next I

'Command find
'Browse row 1 from line 1 to 3
For x = 1 To 3
    Set foundText1 = objSld.Shapes("Table1").Table.Cell(x, 1).Shape.TextFrame.TextRange.Find(FindWhat:="Comp")
    If foundText1 = "Comp" Then
        'MsgBox foundText1 & x
        'Will write in cell (x,2) OK and x
        objSld.Shapes("Table1").Table.Cell(x, 2).Shape.TextFrame.TextRange.Text = "OK " & x
    Else
   'Will write in cell (x,2) NOK and x
    'Doesn't works !! Why??
        objSld.Shapes("Table1").Table.Cell(x, 2).Shape.TextFrame.TextRange.Text = "NOK " & x
    End If
Next x
End With
End Sub

Я хотел бы знать, если вы видите, где ошибка. Кажется, функция Else не работает ..

1 Ответ

0 голосов
/ 05 июля 2018

Я нашел решение !!

Для тех, кто потерян с этой же проблемой, вот мой код: 

Public Sub CreateTable1()
' déclaration of variables
Dim objSld As Slide
Dim objShp As Shape
Dim foundText1 As Object
Dim TextRng As TextRange
Dim FindWhat As String
Dim I As Integer
Dim j As Integer

Set objSld = ActivePresentation.Slides(8)
Set objShp = objSld.Shapes.AddTable(3, 3, 15, 150, 700, 500)

' Give a name to table
 objShp.Name = "Table1"

' Define size of cells
With objSld.Shapes("Table1").Table
    .Columns(1).Width = 115
    .Columns(2).Width = 115
    .Columns(3).Width = 115
    .Rows(1).Height = 120
    .Rows(2).Height = 120
    .Rows(3).Height = 120

    'Write in cells
    With .Cell(1, 1).Shape.TextFrame
        .TextRange.Text = "Composition"
    End With
    With .Cell(2, 1).Shape.TextFrame
        .TextRange.Text = "Material"
    End With
    With .Cell(3, 1).Shape.TextFrame
        .TextRange.Text = "Method"
    End With

' Define text position
    For I = 1 To 3
        For j = 1 To 3
            With .Cell(j, I).Shape.TextFrame
                .VerticalAnchor = msoAnchorMiddle
                .HorizontalAnchor = msoAnchorCenter
                .TextRange.Font.Size = 18
            End With
        Next j
    Next I

'Command find
'Browse row 1 from line 1 to 3
End With
End Sub

Создание второго саба, чтобы понять, где произошел сбой скрипта Sub yolo () 

Dim objSld As Slide
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long
Dim foundText1 As Object
Set objSld = ActivePresentation.Slides(8)

Set oTbl = objSld.Shapes("Table1").Table
With oTbl

    For lRow = 1 To .Rows.Count
            With .Cell(lRow, 1).Shape

               'Do something with each cell's text
               'Does this shape has text?
                If .HasTextFrame Then
                    Set TextRng = oTbl.Cell(lRow, 1).Shape.TextFrame.TextRange
                        Set foundText1 = TextRng.Find(FindWhat:="Comp")
                        Do While Not (foundText1 Is Nothing)
                            With foundText1
                                oTbl.Cell(lRow, 2).Shape.TextFrame.TextRange.Text = "OK"
                                Set foundText1 = TextRng.Find(FindWhat:="Comp", After:=.Start + .Length - 1)
                            End With
                        Loop
                End If
            End With
        Next lRow
End With

End Sub
...