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 |
|
