Hugo121
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору Option Explicit Sub ToComment() Dim flag As Boolean Dim i As Long, x As Long, y As Long, z As Long Dim sep_ As Long, start_ As Long, end_ As Long Dim str_ As String Dim b(), ind As Long, zz As Long Dim bstart_ As Long, blen_ As Long Dim stbar As Boolean stbar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.ScreenUpdating = False For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1 If flag = False Then If Cells(i, 1).Value <> "" Then flag = True: x = i ElseIf flag Then If IsNumeric(Mid(Cells(i, 1).Value, 2, 1)) Then If sep_ = 0 Then sep_ = InStr(Cells(i, 1).Value, ":") If start_ = 0 Then start_ = InStr(Cells(i, 1).Value, "[") + 1 If end_ = 0 Then end_ = InStr(Cells(i, 1).Value, "]") - 1 End If If Cells(i, 1).Value = "" Then flag = False: y = i - 1 ': Debug.Print "x= " & x & " y= " & y & " start= " & start_ & " end= " & end_ & " sep= " & sep_ With Sheets(2).Cells(Int(Mid(Cells(i - 1, 1).Value, start_, sep_ - start_)), Int(Mid(Cells(i - 1, 1).Value, sep_ + 1, end_ - sep_))) For z = x To y If Cells(z, 1).Font.Bold = True Then 'если есть жирность bstart_ = Len(str_) + 1 'начало жирности blen_ = Len(Cells(z, 1).Value) 'длина жирности ReDim Preserve b(1, ind) 'переопределяем массив b(0, ind) = bstart_ 'заносим жирность в массив b(1, ind) = blen_ 'заносим жирность в массив ind = ind + 1 'будущая размерность массива End If str_ = str_ & Cells(z, 1).Value & Chr(10) Next str_ = Left(str_, Len(str_) - 1) 'итоговая строка Application.StatusBar = "Add Comment in Row " & Int(Mid(Cells(i - 1, 1).Value, start_, sep_ - start_)) & " Column " & Int(Mid(Cells(i - 1, 1).Value, sep_ + 1, end_ - sep_)) .ClearComments .AddComment .Comment.Visible = False .Comment.Text Text:=str_ .Comment.Shape.TextFrame.AutoSize = True str_ = "" 'теперь наводим жирность! With Sheets(2).Cells(Int(Mid(Cells(i - 1, 1).Value, start_, sep_ - start_)), Int(Mid(Cells(i - 1, 1).Value, sep_ + 1, end_ - sep_))).Comment.Shape.TextFrame For zz = 0 To ind - 1 'перебор массива жирности With .Characters(Start:=b(0, zz), Length:=b(1, zz)).Font .Name = "Arial Cyr" 'тут можно задать шрифт .FontStyle = "полужирный" 'и стиль .Size = 10 'и размер этой жирности End With Next zz ind = 0 'сбрасываем размер будущего массива в 0 End With End With sep_ = 0: start_ = 0: end_ = 0 End If End If Next Application.ScreenUpdating = True Application.DisplayStatusBar = stbar Application.StatusBar = False End Sub | Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 21:11 03-07-2010 | Исправлено: Hugo121, 23:55 03-07-2010 |
|