Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function WNetGetUserA Lib "mpr.dll" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Function GetComputerName() As String
Dim sBuffer As String * 255
If GetComputerNameA(sBuffer, 255&) <> 0 Then
GetComputerName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Function

Function GetUserName() As String
Dim sUserNameBuff As String * 255
sUserNameBuff = Space(255)
Call WNetGetUserA(vbNullString, sUserNameBuff, 255&)
GetUserName = Left$(sUserNameBuff, InStr(sUserNameBuff, vbNullChar) - 1)
End Function

Sub UserLog()
Dim fPath As String
Dim fName As String
Dim nLogtxt As String

nLogtxt = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, "Helper.xls", "New Folder\IdLog.txt")

    Open nLogtxt For Append As #1
        Print #1, Application.UserName & " -- " & Now & " -- " & GetComputerName & " -- " & GetUserName & " Номер: " & Sheets("Sheet2").Cells(1, "C") & " -- " & Sheets("Sheet2").Cells(9, "D") & "/" & Sheets("Sheet2").Cells(17, "A") & "/" & Sheets("Sheet2").Cells(18, "A") & "/" & Sheets("Sheet2").Cells(19, "A") & "/" & Sheets("Sheet2").Cells(20, "A") & "/" & Sheets("Sheet2").Cells(21, "A") & "/" & Sheets("Sheet2").Cells(22, "A") & "/" & Sheets("Sheet2").Cells(23, "A") & "/" & Sheets("Sheet2").Cells(24, "A") & Sheets("Sheet2").Cells(25, "A") & "/" & Sheets("Sheet2").Cells(26, "A") & "/" & Sheets("Sheet2").Cells(27, "A") & "/" & Sheets("Sheet2").Cells(28, "A") & "/" & Sheets("Sheet2").Cells(29, "A")

    Close #1
     
    Sheets("Sheet2").Select
    Range("A17:A29").Select
    Selection.ClearContents
    Sheets("Sheet1").Select
    Columns("A:S").Select
    Selection.Clear
    ActiveSheet.DrawingObjects.Select
    Selection.Delete
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "" & Chr(10) & "Внесите данные в эту ячейку" & Chr(10) & ""
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveSheet.Buttons.Add(1075.5, 93.75, 100.5, 42.75).Select
    Selection.OnAction = "UserLog"
    Selection.Characters.Text = "ОЧИСТИТЬ"
    With Selection.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "обычный"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("A1").Select
End Sub