Sub Macro1()
    SolverOk SetCell:="$C$6", MaxMinVal:=3, ValueOf:=8, ByChange:="$C$4", Engine:=1 _
        , EngineDesc:="GRG Nonlinear"
    SolverOk SetCell:="$C$6", MaxMinVal:=3, ValueOf:=8, ByChange:="$C$4", Engine:=1 _
        , EngineDesc:="GRG Nonlinear"
    SolverSolve
End Sub

ИмяКнопки.Picture=LoadPicture(«адрес картинки»)

HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associati­ons\UrlAssociations\http\UserChoice

Public Declare Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal FileName As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long
 
 
'------------------------------------------------------------------------
' Open Webpage in default browser
'------------------------------------------------------------------------
Public Sub OpenUrl(strURL)
    Dim lSuccess As Long
    lSuccess = ShellExecute(0, "Open", strURL)
End Sub


Sub OpenUr()
    Call OpenUrl("https://yandex.ru")
End Sub

Enum BrowserName    'This Enum is part of Sub OpenURL()
    InternetExplorer = 1
    FireFox = 2
    Chrome = 3
    Opera = 4
    Edge = 5
    Brave = 6
End Enum
 
 
'---------------------------------------------------------------------------------------
' Procedure : OpenURL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Open a URL in FireFox
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL      : URL to open in FifeFox
'
' Usage:
' ~~~~~~
' Call OpenURL("http://www.google.ca", InternetExplorer)
' Call OpenURL("devhut.net", Chrome)
' Call OpenURL("msdn.com", FireFox)
' Call OpenURL("google.ca", Opera)
' Call OpenURL("http://www.google.ca", Edge)
' Call OpenURL("http://www.google.ca", Brave)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2014-11-13              Initial Release
' 2         2018-02-01              Updated Copyright under CC licensing
'                                   Error trapped FireFox not installed
' 3         2018-02-01              Complete revamp of the code to accomodate multiple
'                                   Browser
' 4         2020-04-27              Added Microsoft Edge
'                                   Added Brave
'---------------------------------------------------------------------------------------
Sub OpenURL(ByVal sURL As String, ByVal lBrowser As BrowserName)
    On Error GoTo Error_Handler
    Dim WSHShell              As Object
    Dim sFFExe                As String     'Executable path/filename
    Dim sProgName             As String     'Name of the Executable program
    Dim sExe                  As String     'Excutable exe filename
    Dim sCmdLineSwitch        As String     'Command line switch
    Dim sShellCmd             As String     'Shell Command
 
    'Determine the Path to FF executable
    Select Case lBrowser
        Case 1
            'https://msdn.microsoft.com/en-us/library/hh826025(v=vs.85).aspx
            sProgName = "Internet Explorer"
            sExe = "IEXPLORE.EXE"
            sCmdLineSwitch = " "
        Case 2
            'https://developer.mozilla.org/en-US/docs/Mozilla/Command_Line_Options#Browser
            sProgName = "Mozilla Firefox"
            sExe = "Firefox.EXE"
            sCmdLineSwitch = " -new-tab "
        Case 3
            sProgName = "Google Chrome"
            sExe = "Chrome.exe"
            sCmdLineSwitch = " -tab "
        Case 4
            'http://www.opera.com/docs/switches/
            sProgName = "Opera"
            sExe = "opera.exe"
            sCmdLineSwitch = " "
        Case 5
            sProgName = "Microsoft Edge"
            sExe = "Chrome.exe"
            sCmdLineSwitch = " -tab "
        Case 6
            sProgName = "Brave"
            sExe = "brave.exe"
            sCmdLineSwitch = " -tab "
    End Select
 
    If lBrowser = 5 Then    'Special case for Edge!  Thank you Microsoft for not following the rules!
        sShellCmd = "cmd /c """ & "start microsoft-edge:" & sURL & """"
    Else
        Set WSHShell = CreateObject("WScript.Shell")
        sFFExe = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _
                                  "CurrentVersion\App Paths\" & sExe & "\")
        sFFExe = Replace(sFFExe, Chr(34), "")    'Special case for Opera?!
        'Open the URL
        sShellCmd = """" & sFFExe & """" & "" & sCmdLineSwitch & """" & sURL & """"
    End If
    shell sShellCmd, vbHide
 
Error_Handler_Exit:
    On Error Resume Next
    If Not WSHShell Is Nothing Then Set WSHShell = Nothing
    Exit Sub
 
Error_Handler:
    If Err.Number = -2147024894 Then
        MsgBox sProgName & " does not appear to be installed on this compter", _
               vbInformation Or vbOKOnly, "Unable to open the requested URL"
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: OpenURL" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Sub

Option Base 1
Sub TabSelect()
  Dim Shts() As Integer
  Dim i As Integer
  Dim n As Integer
  Dim Col: Col = ActiveSheet.Tab.Color 
  For i = 1 To ActiveWorkbook.Sheets.Count
    If ActiveWorkbook.Sheets(i).Visible = True And ActiveWorkbook.Sheets(i).Tab.Color = Col Then
        n = n + 1
        ReDim Preserve Shts(n)
        Shts(n) = i
    End If
  Next
   ActiveWorkbook.Worksheets(Shts).Select
End Sub

Sheets(Array("Лист1", "Лист2", "Лист3")).Select

Sub Макрос1()
    Dim F As Object
    Set F = Workbooks.Open("C:\Users\User\Desktop\222.xlsx")
    ActiveWorkbook.Close
    MsgBox F.Name
End Sub

Dim F as Object
Set F="C:\Users\User\Desktop\Тест v1.xlsb"

Sub Test()
MsgBox ActiveSheet.Protection.AllowEditRanges(1).Password
End Sub

Sub Макрос1
ActiveSheet.Protection.AllowEditRanges.Add Title:="Диапазон1", Range:=Range _
        ("F6"), Password:="1" 
End Sub

Sub Макрос1
   
 ActiveSheet.Protection.AllowEditRanges.Add Title:="Диапазон1", Range:=Range _
        ("F6"), Password:="1"  
 
End Sub

Sub Макрос2()   

   MsgBox ActiveSheet.Protection.AllowEditRanges(1).Users(1).Name

End Sub

Sub Макрос13()

    ActiveSheet.Protection.AllowEditRanges(1).Users.Add Name:="User"
        
End Sub