Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem excel 2010, ako sa z indexoveho zoznamu harkov presunut na dany harok 1 klikom

Ok dik
cize toto by mala byt finalna verzia:

Sub Sheet_lister()
Dim ceLL As Range
Dim i As Long
Dim Button1 As Object
Dim Button2 As Object
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Exist As Boolean

Application.ScreenUpdating = False

For Each Ws1 In Worksheets
    If Ws1.Name Like "Sheet List" Then Exist = True: Exit For
    Next
        If Exist = True Then
            With Sheets("Sheet List")
                .Activate
                .Columns(1).Clear
                .Columns(3).Clear
            End With
        Else
            Sheets.Add before:=Worksheets(1)
            ActiveSheet.Name = "Sheet List"
            
            With Range("A1")
                Set Button2 = ActiveSheet.Buttons.Add(Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
            End With
    
            With Button2
                .Name = "Button2"
                .OnAction = "Sheet_lister"
                .Characters.Text = "Make list"
                .Characters.Font.Name = "Arial"
                .Characters.Font.Size = 11
                .Characters.Font.Color = vbRed
                '.Characters.Font.Bold = True
            End With
            
        End If


For i = 2 To Sheets.Count
Cells(i + 1, 1) = Sheets(i).Name
If Not (Sheets(i).Range("A1").Comment Is Nothing) Then Cells(i + 1, 3) = Sheets(i).Range("A1").Comment.Text
Columns(1).AutoFit
Columns(3).AutoFit

If Columns(1).ColumnWidth < 18 Then
    Columns(1).ColumnWidth = 18
End If

Cells(i + 1, 1).NumberFormat = "@* "
Next i


For Each ceLL In Range("A3", Range("A3").End(xlDown))
ceLL.Hyperlinks.Add Anchor:=ceLL, Address:="", _
SubAddress:="'" & Replace(ceLL.Value, "'", "''") & "'" & "!a1", ScreenTip:="Click to move to sheet", TextToDisplay:=ceLL.Value
Next

Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row).Font.Underline = xlUnderlineStyleNone


Application.ScreenUpdating = True
Sheets("Sheet List").Activate
End Sub




Sub Back()
Sheets("Sheet List").Activate
End Sub




Sub Update_comments()
Dim y As Long
Dim new_comment As String

For y = 2 To Sheets.Count
new_comment = Cells(y + 1, 3).Value
    With Sheets(y).Range("A1")
        .ClearComments
        .AddComment
        .Comment.Text Text:=new_comment
    End With
Next y
Columns(3).AutoFit
End Sub


1, Pri testovani: Ked pridam novy koment, aplikujem sikoho makro, vymazem koment, aplikujem sikoho makro. Nemalo by v danom harku ostat nic, ale vidim:
http://i.imgur.com/WBimRD9.png
Da sa makro upravit, aby si po sebe upratalo bubliny bez obsahu ?

2, V praxi, ked sa vratim k mojmu suboru po dlhsom case, moze sa lahko stat, ze okomentujem zopar novych harkov a zabudnem spustit sikoho makro predtym ako stlacim Make list.
Dalo by sa sikiho makro nasilu implementovat dovnutra tlacitkoveho makra, aby pri stlaceni tlacitka Make list, este predtym ako ten list urobi, aby aplikoval sikiho makro ?

vdaka

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny