Dim WshNetwork As Object, sCompName As String, oUser As Object, sName
Set WshNetwork = CreateObject("WScript.Network")

sCompName = WshNetwork.ComputerName  'получаем имя компа

sName = WshNetwork.UserName          'получаем имя текущего пользователя

On Error Resume Next

'sName - имя пользователя на компьюторе
Set oUser = GetObject("WinNT://" & sCompName & "/" & sName & ",user")

'новый пароль
'oUser.SetPassword "2584"

'или такой синтаксис
oUser.SetPassword ("2584")

'ввод нового пароля
oUser.SetInfo

Private Sub DTPicker1_Change()
Sheets("Лист1").Range("F7") = Format(DTPicker1.Value, "dd.mm.yyyy hh:mm")
End Sub

Private Sub UserForm_Initialize()
   If IsDate(Sheets("Лист1").Range("F7").Value) Then
DTPicker1.Value = Sheets("Лист1").Range("F7").Value
   End If
End Sub

ActiveWorkbook.Names.Add Name:="Диапазон1", RefersTo:="=Лист2!$A$1:$B$2", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон2", RefersTo:="=Лист2!$A$3:$B$4", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон3", RefersTo:="=Лист2!$A$5:$B$6", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон4", RefersTo:="=Лист2!$A$7:$B$8", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон5", RefersTo:="=Лист2!$A$9:$B$10", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон6", RefersTo:="=Лист2!$A$11:$B$12", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон7", RefersTo:="=Лист2!$A$13:$B$14", Visible:=False
ActiveWorkbook.Names.Add Name:="Диапазон8", RefersTo:="=Лист2!$A$15:$B$16", Visible:=False

Sheets("Лист2").Range("D2") = "=DAVERAGE(База!A:AP,4,Лист2!A1:B2)"
'пишу
Sheets("Лист2").[D2] = Application.DAverage(Sheets("База").[A:AP], 4, Sheets("Лист2").[A1:B2])
'дает #ДЕЛ/0!

Workbooks.OpenText Filename:= _
        "http://92.40.205.91/cgi-bin/cgi-iox?proc=60&path=iox/database/av1.txt&unit=2&crosstable=y&time=2014/07/24 00:00&period=24"

Sub  Макрос
   Range("A8:GR8").Copy _
         Sheets("Отчет").Range("A65536").End(xlUp)
End Sub

Sub Объекты()
 Sheets("Таблица").Select
  If Range("C16,C17,C18,C19,C20") = " " Then
   Range("L2") = Range("A15")
   Else
   Range("L2") = " "
   End If
End Sub

Sub Макрос1()
    Range("A7".Select
    ActiveCell.FormulaR1C1 = "=База_хроматографа!R[2190]C[18]"  
End Sub

Columns("A:L".Select
       Selection.ClearContents
    Selection.QueryTable.Delete
    Range("A2".Select
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\Каустик\AnalogInData.dat" _
        , Destination:=Range("A2")
        .Name = "AnalogInData_81"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 866
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(4, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(8, 3, 2, 2, 5, 4, 5, 4, 7, 5, 5)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("I:I".Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "0.00"
    Columns("D".Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

Public Function Vin2(x)
Vin2 = IIf(IsError("x"), " ", IIf((x < 0), 0, 3))
End Function

Sheets("Таблица").Select
    Sheets("Таблица").Copy
    ChDir "D:\Костя"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Костя\ Название .xls", FileFormat:= _
        xlNormal, CreateBackup:=False
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    ActiveSheet.Unprotect Password:="07" ' снимаем пароль с Листа1
    Columns("M:N").Select
    Selection.Delete Shift:=xlToLeft