Excel / VBA: определить внутренний вес шрифта IE - PullRequest
Новая
       21

Excel / VBA: определить внутренний вес шрифта IE

0 голосов
/ 27 ноября 2018

Мне нужно определить, выделен ли полужирный шрифт выбранного внутреннего текста.Мне просто нужен рабочий синтаксис.Пожалуйста, помогите: (

Сейчас я использую это, но оно не работает: 

If elemCollection(t).Rows(r).Cells(c).fontWeight = 400 Then '<-- or "bold"
    MsgBox 1
End If

Редактировать:

У меня есть автоматизация, которая будет собирать информацию в носителевеб-сайт. мой код работает и получает все необходимые данные. и теперь я нахожусь на следующем этапе получения ТОЛЬКО жирного текста на веб-сайте. после нескольких часов поиска в сети я перепробовал много синтаксиса, однако ни один из них не работает. мне просто нужноработать с этой строкой, чтобы я мог перейти к следующему шагу.:) 

If elemCollection(t).Rows(r).Cells(c).style.fontWeight = 400 Then '<-- or 
    "bold"
    'code here
End If

вот мой код. 

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub extractTablesData()
Dim IE As Object, obj As Object
Dim r As Integer, c As Integer, t As Integer
Dim elemCollection, elemClass As Object
Dim wb, twb As Workbook
Dim idStr As String
Dim ctr, RowCtr As Long

Set wb = ActiveWorkbook

DoEvents
For x = 2 To Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
If Sheet2.Range("B" & x).Value <> "" Then
idStr = Sheet2.Range("B" & x).Value
Set IE = CreateObject("InternetExplorer.Application")
Sheet2.Range("A" & x & ":b" & x).Copy
Sheet3.Range("A" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues
With IE
.Visible = True:
'added sample for your reference of the website
.navigate ("click the link"

ссылка 

DoEvents

While IE.readyState <> 4: Wend
Do While IE.readyState = 4 And Not IE.Busy
If IE.readyState = 4 Then
    Exit Do
End If
Sleep 100
DoEvents
Loop

Do While IE.readyState = 4 And Not IE.Busy
Sleep 100
DoEvents:
Loop

DoEvents

Sheet1.Range("A1:K500").ClearContents

Set elemCollection = IE.document.getElementsByTagName("Table")

    For t = 0 To (elemCollection.Length - 1)

        For r = 0 To (elemCollection(t).Rows.Length - 1)
            For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)

            MsgBox elemCollection(t).Rows(r).Cells(c).innerText


         If elemCollection(t).Rows(r).Cells(c).fontWeight = 400 Then
                wb.Worksheets(1).Cells(r + 1, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
                ctr = ctr + 1
           End If


Next c: Next r: Next t: End With: IE.Quit: Set IE = Nothing

Sheet1.Range("A3:F" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row).Copy
Sheet3.Range("C" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial xlPasteValues
If ctr <> 0 Then
    Sheet3.Range("A" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row & ":B" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row).Copy
    Sheet3.Range("A" & Sheet3.Cells(Rows.Count, 1).End(xlUp).Row & ":B" & Sheet3.Cells(Rows.Count, 3).End(xlUp).Row).PasteSpecial xlPasteValuesAndNumberFormats
End If
ctr = 0: Z = 0:
End If
Next:

End Sub
...