триене на код

в екселски файл съм написъл доста код на VB , който искам да се изтрие автоматично при определена ситуация (например при опит за намеса или в определен момент)
Някой знае ли как мога да го направя

!!!!!!??????!!!!!!!??????!?!?!??!?!

Ти си гений, човече!!!

Започвам да работя по такъв "Add-in" за Excel. ... Лошото е, че ако юзера се сети за този вариант, и стартира Excel с изключени макроси - дори кода за триене на код няма да сработи.


Щирлиц

Абе да се надяваме, че потребителя, ще се усети чак след изтриване. А и повечето от тях не знаят от къде се включва VB.
А със сигурност знам, че нивото на сигурност на компютъра където ще се инсталира е ниска.
Та ако имаш някаква макар и слаба идея, някаква насока за мислене подхвърли я, ако обичаш. Защото до края на седмицата трябва да предложа demo версия на програмката си.

Не мисля че можеш да изтриеш зареден макрос.
Най-близкото за което се сещам е да сложиш някаква информация от която макроса се нуждае във външен файл или в регистри - това вече се трие лесно.

По принцип ако искаш да си защитиш кода или да предотвратиш бърникане в него, може да го сложиш в .длл или ВБ .ехе което използва Ексел.Аутомейшън
Виждал съм и екселски файлове които не дават да им пипаш макросите - не знам как се прави, но сигурно подобна защита се маха лесно.

Стандартната защита на макросите в ексела (до Office XP включително) е пълна боза. Ако отвориш екселски файл с макроси през notepad, дори да е защитен от гледане и криптиран, е до 60% разчетим с просто око.
Интересното е, че ако самото съдържание на екселския файл (в клетките) след версия 2000 е доста добро (!!)

Не е така обаче с .xla файловете, при които криптирането вече е на добро ниво и на практика е невъзможно да се разкриптират. Мисля, че Microsoft са направили това разграничение заради third-party add-in-ите (които винаги идват във вид на .xla).

Така че запазвайте макросите само в .xla файлове и можете да спите спокойно.
За съжаление прочетох за тези важни подробности едва след като изгорях веднъж от подобни "безобидни" клиенти. Не е нужно да си програмист, за да хакнеш лошо защитен екселски файл - в нета има един куп програми, които го правят елементарно и за лаици.

Never Underestimate the power of stupid people in large groups.

Добре де, ами акo направя на ....xla Save As ....xls всичко пак ще лъсне с елементарна програма за разбиване на парола.

Работата е ясна. Няма смисъл. Пишете сериозните неща на VB6, и си свиркайте.

Има и друг сложен момент. Писал съм и горе-долу "големи" проекти на Excel. Всичко работи добре, докато не преместя xls файла на друг компютър, където е възможно да има по-нова или по-стара версия на Excel. На практика дори ХР и 2003 не са съвместими, и възникват какви ли не странни грешки. Та аджиба възможно ли е Office XP да няма функцията "Mid()"??? ;о))) Че я има, има я, и работи даже, но как аджиба може програмиста да предвиди къде кой SP за Office ще има инсталиран, за да си съобрази приложението с него. Докато на Self EXE подобен проблем не би съществувал. Хора, пишете си на VB6 или VB.NET, или каквото можете от подобен калибър.


Щирлиц

звучи лесно ама като не знаем какво е self exe и как става писането на VB6 и от къде да го свалим. повечето от нас са лаици

На .xla файл не можеш да му дадеш Save As, аз поне не съм успявал досега.
Тази работа с .xla-тата наистина е така. Пробвай например да счупиш защитата на някой от .xla-тата, които вървят като add-in-и с Ексела: ATPVBAEN.xla, FUNCRES.xla, XLQUERY.xla, SOLVER.xla ...

Never Underestimate the power of stupid people in large groups.

sloji si parola na vb koda
ima go v opciite

Хехе. И тази парола ще ме забави колко време? ... 5-10 секунди!?!?


Щирлиц

Lock project for viewing? Дали ще свърши работа? Той май изобщо не реагира на пароли.

Вижте сега. За пароли на Excel-ски файлове - забравете въобще. Аз не слагам пароли на такива проекти дори против ламерите. По простата причина, че се "разбиват" (те нямат нужда от разбиване, виждат си се съвсем нормално) за секунди с най-простия Password Recover. А ако почна да си пазя VBA проектите от ламери с пароли - само ще ги подстрекавам да се учат на разбиване.

Ако ще пишеш комерсиални проекти - пиши на VB6. Компилирай, мини ЕХЕ-то през Executable Protector, и си свиркай.


Щирлиц

Парола на прект във VBA е изключително тъпо нещо, защото се хаква за 10 минути. След един такъв случай, който ми струваше откраднати 6 месеца работа, никога вече не ги ползвам. После видях, че за да научиш всичко нужно за сигурността в Ексел не отнема повече от 6 часа.
Но защитата във вид на .xla файл наистина е на практика неразбиваема. Ако някой твърди друго - моля нека отвори по някакъв начин файла SOLVER.xla. Ще платя за кода без много пазарене!
Другият начин за защита на макроси в Ексел, който дори е по-ефикасен, е създаване на .xll файлове. Това всъщност са .dll файлове, преименувани на .xll според документацията на Майкрософт. Де факто компилиран код, който е пригоден за нуждите на VBA.
Има много добри туториъли в нет-а за сигурността във VBA. Питайте Гугъл за VBA+security например.

Never Underestimate the power of stupid people in large groups.

"Ще платя за кода без много пазарене! "

Дължиш ми тридесетак.

Public Static Sub Main()

    ' This is the main routine, displaying the Solver dialog box, and taking appropiate

    ' action, depending on what the user does.

    Dim savecalculation As Integer, savestatusbar As Boolean, savescreenupdate As Boolean

    Dim dummy As String, i As Integer, c, vbacode As String, thearray

    Dim newpart As String, dummy2 As Integer

    SolverName

    On Error GoTo errorhandling



    If ActiveSheet.Type <> xlWorksheet Or ActiveSheet.ProtectContents Then

        MsgBox excel4language.Range("solver_msg_1").Text, 32, , HelpFile, 1830

        End

    End If



    If ActiveWorkbook.IsInplace = True Then

        MsgBox excel4language.Range("solver_msg_1c").Text, 32, , HelpFile, 1830

        End

    End If



    If Left(Application.OperatingSystem, 1) = "W" Then

        If Application.Version > CStr(6) Then

            If ActiveWorkbook.MultiUserEditing Then

                MsgBox excel4language.Range("solver_msg_1").Text, 32, , HelpFile, 1830

                End

            End If

        End If

    End If



    If ActiveWindow.SelectedSheets.Count > 1 Then

        MsgBox excel4language.Range("solver_msg_1b").Text, 32, , HelpFile, 1830

        End

    End If



    thearray = Application.RegisteredFunctions



    If IsNull(thearray) Then

        MsgBox excel4language.Range("solver_msg_1a").Text, 32, , HelpFile, 1830

    Else

        dllavail = False



        For i = LBound(thearray) To UBound(thearray)



            If Left(Application.OperatingSystem, 1) = "W" Then

                If Right(thearray(i, 1), 12) = "SOLVER32.DLL" Then

                    dllavail = True

                    Exit For

                End If



            Else



                If Right(thearray(i, 1), 13) = "Solver Add-In" Then

                    dllavail = True

                    Exit For

                End If

            End If



        Next



        If Not dllavail Then

            MsgBox excel4language.Range("solver_msg_1a").Text, 32, , HelpFile, 1830

        End If

    End If



    On Error GoTo mainerror

    savestatusbar = Application.DisplayStatusBar

    Application.DisplayStatusBar = True

    savescreenupdate = Application.ScreenUpdating

    Application.EnableCancelKey = xlDisabled

    savestyle = Application.ReferenceStyle

    On Error GoTo selectionerror

    currentarea = Selection.Address(ReferenceStyle:=savestyle)

    On Error GoTo mainerror

    fresh = False

    On Error GoTo freshhandle

    dummy = ActiveSheet.Names("solver_typ")

    On Error GoTo mainerror

    Application.ScreenUpdating = False

    solver_typ = 1



    If fresh Then

        Set_defaults

    Else

        Get_settings

    End If



    Action = ""

    Application.RecordMacro basiccode:=""

    While Action <> "Cancel"

        Application.ScreenUpdating = True

        Action = "Cancel"

        On Error Resume Next

        ThisWorkbook.DialogSheets("Solver_dialog").Show

        On Error GoTo mainerror



        If Action <> "Cancel" And Action <> "" Then

            Define_names

            solver_adj = ""

            On Error Resume Next

            solver_adj = Range(ActiveSheet.Names("solver_adj").Name).Address

            newpart = ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes( _

                    "dValueof").Caption



            If "." <> Application.International(xlDecimalSeparator) Then

                dummy2 = InStr(newpart, Application.International(xlDecimalSeparator))

                newpart = Left(newpart, dummy2 - 1) & "." & Mid(newpart, dummy2 + 1)

            End If



            If solver_opt = "" And solver_adj <> "" Then

                If savestyle = xlA1 Then

                    vbacode = excel4language.Range("okfunc").Text & " " & _

                            excel4language.Range("okarg2").Text & ":="

                    vbacode = vbacode & solver_typ & ", " & excel4language.Range( _

                            "okarg3").Text & ":=" & Chr(34) & newpart & Chr(34)

                    vbacode = vbacode & ", " & excel4language.Range("okarg4").Text & _

                            ":=" & Chr(34) & solver_adj & Chr(34)

                Else

                    vbacode = excel4language.Range("okfunc").Text & " " & _

                            excel4language.Range("okarg2").Text & ":="

                    vbacode = vbacode & solver_typ & ", " & excel4language.Range( _

                            "okarg3").Text & ":=" & Chr(34) & newpart & Chr(34)

                    vbacode = vbacode & ", " & excel4language.Range("okarg4").Text & _

                            ":=" & Chr(34) & Application.ConvertFormula(solver_adj, _

                            xlA1, xlR1C1) & Chr(34)

                End If



                Application.RecordMacro basiccode:=vbacode

            Else



                If solver_opt <> "" And solver_adj <> "" Then

                    If savestyle = xlA1 Then

                        vbacode = excel4language.Range("okfunc").Text & " " & _

                                excel4language.Range("okarg1").Text & ":=" & Chr(34) & _

                                solver_opt & Chr(34) & ", "

                        vbacode = vbacode & excel4language.Range("okarg2").Text & ":="

                        vbacode = vbacode & solver_typ & ", " & excel4language.Range( _

                                "okarg3").Text & ":=" & Chr(34) & newpart & Chr(34)

                        vbacode = vbacode & ", " & excel4language.Range("okarg4").Text _

                                & ":=" & Chr(34) & solver_adj & Chr(34)

                    Else

                        vbacode = excel4language.Range("okfunc").Text & " " & _

                                excel4language.Range("okarg1").Text & ":=" & Chr(34) & _

                                Application.ConvertFormula(solver_opt, xlA1, xlR1C1) & _

                                Chr(34) & ", "

                        vbacode = vbacode & excel4language.Range("okarg2").Text & ":="

                        vbacode = vbacode & solver_typ & ", " & excel4language.Range( _

                                "okarg3").Text & ":=" & Chr(34) & newpart & Chr(34)

                        vbacode = vbacode & ", " & excel4language.Range("okarg4").Text _

                                & ":=" & Chr(34) & Application.ConvertFormula( _

                                solver_adj, xlA1, xlR1C1) & Chr(34)

                    End If



                    Application.RecordMacro basiccode:=vbacode

                End If

            End If

        End If



        Select Case Action



            Case "Add"

                Application.ScreenUpdating = True

                Add_constraint



            Case "Delete"

                Delete_constraint



            Case "Change"

                Application.ScreenUpdating = True

                Change_constraint



            Case "Options"

                While Action = "Options" Or Action = "Save_model" Or Action = _

                        "Load_model" Or Action = "Saveload"



                    Select Case Action



                        Case "Options"

                            Application.ScreenUpdating = True

                            Show_options



                        Case "Save_model"

                            Application.ScreenUpdating = True

                            Save_model



                        Case "Load_model"

                            Application.ScreenUpdating = True

                            Load_model

                    End Select



                    If Action = "Saveload" Then

                        SaveLoad_ok



                        If Action = "Saveload" Then

                            Action = "Options"

                        ElseIf Action = "Save_again" Then

                            Action = "Save_model"

                        End If

                    End If



                Wend



            Case "CallSolver"

                Application.StatusBar = excel4language.Range("msg_setup").Text

                Application.ScreenUpdating = False

                Define_names



                If Not dllavail Then

                    MsgBox excel4language.Range("solver_msg_1a").Text, 32, , HelpFile, _

                            1830

                ElseIf Problem_ok() Then



                    If ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes( _

                            "Optimum_cell").Text = "" Then

                        oldobj = CVErr(xlErrNA)

                    Else

                        oldobj = Range(Stylecheck(ThisWorkbook.DialogSheets( _

                                "Solver_dialog").EditBoxes( _

                                "Optimum_cell").Caption)).Value

                        oldobjformat = Range(Stylecheck(ThisWorkbook.DialogSheets( _

                                "Solver_dialog").EditBoxes( _

                                "Optimum_cell").Caption)).NumberFormat

                    End If



                    ReDim oldvars(Range(solver_adj).Count)

                    ReDim oldvarformats(Range(solver_adj).Count)

                    i = 1



                    For Each c In Range(solver_adj)

                        oldvars(i) = c.Value

                        oldvarformats(i) = c.NumberFormat

                        i = i + 1

                    Next



                    Range(Stylecheck(currentarea)).Select

                    answer = Application.Run("'" & ThisWorkbook.Name & "'!Solvecall")

                    Application.RecordMacro basiccode:=excel4language.Range( _

                            "solvefunc").Text

                    Application.ScreenUpdating = True

                    Application.GoTo Range(Stylecheck(currentarea))

                    Finish

                    Action = "Cancel"

                End If



        End Select



    Wend

    Application.ScreenUpdating = False

    Range(Stylecheck(currentarea)).Select

    Application.DisplayStatusBar = savestatusbar

    Application.StatusBar = False

    Application.ScreenUpdating = savescreenupdate

    Exit Sub

selectionerror:



    Range("$A$1").Select

    currentarea = Selection.Address(ReferenceStyle:=savestyle)

    Resume Next

mainerror:



    MsgBox excel4language.Range("solver_err_msg").Text, 32, , HelpFile, 1830

    End

errorhandling:



    MsgBox excel4language.Range("solver_msg_1").Text, 32, , HelpFile, 1830

    End

freshhandle:



    fresh = True

    Resume Next

End Sub

Това е безплатно. :)

Public Static Sub Get_settings()
'gets relevant setting for the worksheet, if not a fresh worksheet
' many options need not always be defined, so "on error resume next"
Dim noproblem As Boolean, newopt As String, newadj As String, dummy
Dim the_right As String, mid_ind As Integer, the_left As String, helpstring As String
Dim i As Integer, j As Integer, newentry As String, theindex As Integer, the_middle As String
noproblem = True
On Error GoTo errortrap
newopt = ActiveSheet.Names("solver_opt")
If noproblem Then
ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("Optimum_Cell").Caption = Get_name(newopt)
Else
ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("Optimum_Cell").Caption = ""
End If
Obj
noproblem = True
newadj = Range(ActiveSheet.Names("solver_adj").Name).Address(ReferenceStyle:=savestyle)
On Error GoTo mainerror
If noproblem Then
ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("Adjustable_Cells").Caption = newadj
Else
ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("Adjustable_Cells").Caption = ""
End If
Adjustables
On Error Resume Next
helpstring = CStr(0)
helpstring = Mid(CStr(ActiveSheet.Names("solver_val")), 2)
ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("dValueof").Text = CStr(CDbl(helpstring))
helpstring = "=1"
helpstring = CStr(ActiveSheet.Names("solver_typ"))
Select Case helpstring
Case "=1"
' ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("dValueof").Enabled = False
ThisWorkbook.DialogSheets("Solver_dialog").OptionButtons("max_button").Value = xlOn
solver_typ = 1
Case "=2"
' ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("dValueof").Enabled = False
ThisWorkbook.DialogSheets("Solver_dialog").OptionButtons("min_button").Value = xlOn
solver_typ = 2
Case "=3"
' ThisWorkbook.DialogSheets("Solver_dialog").EditBoxes("dValueof").Enabled = True
ThisWorkbook.DialogSheets("Solver_dialog").OptionButtons("value_button").Value = xlOn
solver_typ = 3
End Select
ThisWorkbook.DialogSheets("Solver_dialog").ListBoxes("Constraint_list").RemoveAllItems
solver_num = 0
solver_num = CDbl(Mid(CStr(ActiveSheet.Names("solver_num")), 2))
For i = 1 To solver_num
the_left = Mid(CStr(ActiveSheet.Names("solver_lhs" & Trim(Str(i)))), 2)
the_left = Get_name(Range(the_left).Address)
If Len(the_left) > 120 Then
the_left = Range(the_left).Address
End If
mid_ind = CDbl(Mid(CStr(ActiveSheet.Names("solver_rel" & Trim(Str(i)))), 2))
If mid_ind < 4 Then
the_right = Mid(CStr(ActiveSheet.Names("solver_rhs" & Trim(Str(i))).RefersToLocal), 2)
If Not IsNumeric(the_right) Then
On Error Resume Next
Err = 0
the_right = Get_name(Range(the_right).Address)
If Err > 0 Then
' formula
j = InStr(the_right, ActiveSheet.Name)
If j <> 0 Then
If InStr(the_right, "'" & ActiveSheet.Name & "'!") <> 0 Then
j = InStr(the_right, "'" & ActiveSheet.Name & "'!")
Do While j <> 0
the_right = Left(the_right, j - 1) & Right(the_right, Len(the_right) - j - Len(ActiveSheet.Name) - 2)
j = InStr(the_right, "'" & ActiveSheet.Name & "'!")
Loop
Else
Do While j <> 0
the_right = Left(the_right, j - 1) & Right(the_right, Len(the_right) - j - Len(ActiveSheet.Name))
j = InStr(the_right, ActiveSheet.Name)
Loop
End If
End If
If "." <> Application.International(xlDecimalSeparator) Then
j = InStr(the_right, ".")
Do While j <> 0
Mid(the_right, j, 1) = Application.International(xlDecimalSeparator)
j = InStr(the_right, ".")
Loop
End If
Else
If Len(the_right) > 120 Then
the_right = Mid(CStr(ActiveSheet.Names("solver_rhs" & Trim(Str(i)))), 2)
If InStr(the_right, ActiveSheet.Name & "!") <> 0 Then
If InStr(the_right, "'" & ActiveSheet.Name & "'!") <> 0 Then
j = InStr(the_right, "'" & ActiveSheet.Name & "'!")
the_right = Right(the_right, Len(the_right) - j - Len(ActiveSheet.Name) - 2)
Else
j = InStr(the_right, ActiveSheet.Name & "!")
the_right = Right(the_right, Len(the_right) - j - Len(ActiveSheet.Name))
End If
End If
End If
End If
Else
the_right = CStr(CDbl(the_right))
End If
the_middle = ThisWorkbook.DialogSheets("Add_dialog").DropDowns("Options").List(mid_ind)
ElseIf mid_ind = 4 Then
the_right = excel4language.Range("solver_msg_int").Text
the_middle = "="
ElseIf mid_ind = 5 Then
the_right = excel4language.Range("solver_msg_bin").Text
the_middle = "="
End If
newentry = the_left & " " & the_middle & " " & Trim(the_right)
If i > 1 Then
theindex = search(newentry, 1, ThisWorkbook.DialogSheets("Solver_dialog").ListBoxes("Constraint_list").ListCount)
Else
theindex = 0
End If
If theindex = 0 Then
ThisWorkbook.DialogSheets("Solver_dialog").ListBoxes("Constraint_list").AddItem Text:=newentry
Else
ThisWorkbook.DialogSheets("Solver_dialog").ListBoxes("Constraint_list").AddItem Text:=newentry, Index:=theindex
End If
Next
On Error GoTo errorhandler
With ThisWorkbook.DialogSheets("Options_dialog")
.EditBoxes("Max_time").Caption = CStr(CDbl(Mid(CStr(ActiveSheet.Names("solver_tim").RefersToLocal), 2)))
.EditBoxes("Max_iter").Caption = CStr(CDbl(Mid(CStr(ActiveSheet.Names("solver_itr").RefersToLocal), 2)))
.EditBoxes("Precision").Caption = CStr(CDbl(Mid(CStr(ActiveSheet.Names("solver_pre").RefersToLocal), 2)))
.EditBoxes("Tolerance").Caption = CStr(CDbl(Mid(CStr(ActiveSheet.Names("solver_tol").RefersToLocal), 2)) * 100)
'new convergence option will not always be available, so..
On Error Resume Next
.EditBoxes("Convergence").Caption = CStr(0.0001)
.EditBoxes("Convergence").Caption = CStr(CDbl(Mid(CStr(ActiveSheet.Names("solver_cvg").RefersToLocal), 2)))
On Error GoTo errorhandler
If CStr(ActiveSheet.Names("solver_lin")) = "=1" Then
.CheckBoxes("Assume").Value = xlOn
Else
.CheckBoxes("Assume").Value = xlOff
End If
' new option nonneg will not always be there, so..
On Error Resume Next
If CStr(ActiveSheet.Names("solver_neg")) <> "=1" Then
.CheckBoxes("non_neg").Value = xlOff
Else
.CheckBoxes("non_neg").Value = xlOn
End If
On Error GoTo errorhandler
If CStr(ActiveSheet.Names("solver_sho")) = "=1" Then
.CheckBoxes("Show_iter").Value = xlOn
Else
.CheckBoxes("Show_iter").Value = xlOff
End If
If CStr(ActiveSheet.Names("solver_scl")) = "=1" Then
.CheckBoxes("auto_scl").Value = xlOn
Else
.CheckBoxes("auto_scl").Value = xlOff
End If
On Error GoTo errorhandler
If CStr(ActiveSheet.Names("solver_est")) = "=1" Then
.OptionButtons("Tangent").Value = xlOn
.OptionButtons("Quadratic").Value = xlOff
Else
.OptionButtons("Tangent").Value = xlOff
.OptionButtons("Quadratic").Value = xlOn
End If
If CStr(ActiveSheet.Names("solver_drv")) = "=1" Then
.OptionButtons("Forward").Value = xlOn
.OptionButtons("Central").Value = xlOff
Else
.OptionButtons("Forward").Value = xlOff
.OptionButtons("Central").Value = xlOn
End If
If CStr(ActiveSheet.Names("solver_nwt")) = "=1" Then
.OptionButtons("Newton").Value = xlOn
.OptionButtons("Conjugate").Value = xlOff
Else
.OptionButtons("Newton").Value = xlOff
.OptionButtons("Conjugate").Value = xlOn
End If
End With
Exit Sub
mainerror:
MsgBox excel4language.Range("solver_err_msg").Text, 32, , helpfile, 1830
End
errorhandler:
With ThisWorkbook.DialogSheets("Options_dialog")
.EditBoxes("Max_time").Caption = CStr(100)
.EditBoxes("Max_iter").Caption = CStr(100)
.EditBoxes("Precision").Caption = CStr(0.000001)
.EditBoxes("Tolerance").Caption = CStr(5)
.EditBoxes("Convergence").Caption = CStr(0.0001)
.CheckBoxes("Assume").Value = xlOff
.CheckBoxes("non_neg").Value = xlOff
.CheckBoxes("show_iter").Value = xlOff
.CheckBoxes("auto_scl").Value = xlOff
.OptionButtons("Tangent").Value = xlOn
.OptionButtons("Forward").Value = xlOn
.OptionButtons("Newton").Value = xlOn
End With
Exit Sub
errortrap:
noproblem = False
Resume Next
End Sub

Sub SolverName()
Set excel4language = ThisWorkbook.Excel4MacroSheets("Language")
Set excel4sheet = ThisWorkbook.Excel4IntlMacroSheets("Excel4Functions")
Dim i As Integer
If Left(Application.OperatingSystem, 1) = "W" Then
helpfile = "xladdin.chm"
Else
helpfile = ":MS EXCEL HELP"
End If
If Workbooks.Count = 0 Then
MsgBox excel4language.Range("solver_msg_150").Text, 32, , helpfile, 1830
End
End If
thesheetname = ActiveSheet.Name
helpsheetname = ActiveSheet.Name
savestyle = Application.ReferenceStyle
If InStr(helpsheetname, "'") <> 0 Then
For i = 1 To Len(helpsheetname)
If Mid(helpsheetname, i, 1) = "'" Then
Mid(helpsheetname, i, 1) = """"
End If
Next
End If
If Not AutoOpened Then
Auto_open
End If
End Sub

Дай си мейла.

Never Underestimate the power of stupid people in large groups.

is987@abv.bg

Всъщност, SendKeys позволява да се напише макрос, който се изтрива сам.
[линк]