ZXNet эхоконференция «zxnet.pc»

Привет, All!

Hаписал макрос. Которому можно просто указывать avi-файл, а он в нём копается и
пишет в excel имя/номердиска/размер/видеокодек/fps/x/y/аудиокодек/hz/stereo

За 30 минут перегнал 43 диска.
Это 115 фильмов.

Теперь можно фрекать алиас VIDEO - это .xls с последним списком имеющихся
мультиков и макросом ;)

Вот макрос (принимаются советы по его оптимизации, ибо я вообще VB запустил
впервые за всю жизнь 2 дня назад ;):

=== Hачало Windows Clipboard ===
Sub filmbase()

Title = "VBA-скрипт - Создание базы фильмов, v.1.0, c F2065"

If ActiveCell.Column <> 1 Then
Response = MsgBox("Выберите первую ячейку в строке, с которой начать добавление
новый файлов", vbInformation, Title)
GoTo macros_end
End If

xls_line = ActiveCell.Row

If Not IsEmpty(ActiveSheet.Cells(xls_line, 1)) Then
Response = MsgBox("Выбранная строка не пустая. Выберете пустую строку",
vbInformation, Title)
GoTo macros_end
End If

restart:

find_empty_line:
If Not IsEmpty(ActiveSheet.Cells(xls_line, 1)) Then
xls_line = xls_line + 1
GoTo find_empty_line
End If

filename = Application.GetOpenFilename("AVI Files (*.avi),*.avi", 0, "Выберите
файл для добавления в список...", , False)
If filename = False Then
GoTo macros_cancel
End If

filenumber = FreeFile
Open filename For Binary Access Read As filenumber

Dim video_y As Long
Dim video_x As Long
Dim video_filelen As Long
Dim video_temp1 As Long
Dim video_temp2 As Long
Dim video_aud_hz As Long
Dim video_aud_mode As Integer
Dim video_aud_codec As Integer
Dim video_time As Long
Dim video_codec As String
video_codec = "1234"

Get filenumber, 189, video_codec
Get filenumber, 4425, video_aud_codec
Get filenumber, 4429, video_aud_hz
Get filenumber, 4427, video_aud_mode
Get filenumber, 65, video_x
Get filenumber, 69, video_y
video_filelen = LOF(filenumber)
Get filenumber, 33, video_temp1
video_fps = 1000000 / video_temp1
Get filenumber, 49, video_temp2
video_time = (CDbl(video_temp1) * CDbl(video_temp2)) / 1000000

t1 = video_time 60
t2 = video_time - (t1 * 60)
If t2 < 10 Then
t5 = ":0" + Format$(t2)
Else: t5 = ":" + Format$(t2)
End If

t4 = t1 60
t3 = t1 - (t4 * 60)

If t3 < 10 Then
video_time_text = Format$(t4) + ":0" + Format$(t3) + t5
Else
video_time_text = Format$(t4) + ":" + Format$(t3) + t5
End If

Close filenumber

filename_buff = ""
filename = Left$(filename, Len(filename) - 4)
filename_len = Len(filename)
filename_cont:
If Mid$(filename, filename_len, 1) <> "" Then
filename_buff = Mid$(filename, filename_len, 1) + filename_buff
Else
GoTo filename_ok
End If
filename_len = filename_len - 1
If filename_len = 0 Then
GoTo filename_ok
End If
GoTo filename_cont
filename_ok:

Select Case video_aud_codec
Case 0
video_aud_codec_name = "PCM"
Case &H130
video_aud_codec_name = "ACELP"
Case 6
video_aud_codec_name = "CCITT-A"
Case 7
video_aud_codec_name = "CCITT-u"
Case &H22
video_aud_codec_name = "DSP"
Case &H31
video_aud_codec_name = "GSM610"
Case &H11
video_aud_codec_name = "IMA-ADPCM"
Case &H161
video_aud_codec_name = "DivX"
Case &H70
video_aud_codec_name = "L&H-CELP"
Case &H71
video_aud_codec_name = "L&H-SBC-8"
Case &H72
video_aud_codec_name = "L&H-SBC-12"
Case &H73
video_aud_codec_name = "L&H-SBC-16"
Case 2
video_aud_codec_name = "MS-ADPCM"
Case &H42
video_aud_codec_name = "MS-G7321"
Case &H160
video_aud_codec_name = "WMA-V1"
Case &H161
video_aud_codec_name = "WMA-V2"
Case &H55
video_aud_codec_name = "MPEG3"
Case Else
video_aud_codec_name = Hex$(Format$(video_aud_codec)) + "h"
End Select

ActiveSheet.Cells(xls_line, "A") = filename_buff
ActiveSheet.Cells(xls_line, "C") = video_filelen
ActiveSheet.Cells(xls_line, "D") = video_time_text
ActiveSheet.Cells(xls_line, "E") = video_codec
ActiveSheet.Cells(xls_line, "F") = video_fps
ActiveSheet.Cells(xls_line, "G") = video_y
ActiveSheet.Cells(xls_line, "H") = video_x
ActiveSheet.Cells(xls_line, "I") = video_aud_codec_name
ActiveSheet.Cells(xls_line, "J") = video_aud_hz
ActiveSheet.Cells(xls_line, "K") = video_aud_mode

ActiveSheet.Cells(xls_line, "B") = Application.InputBox("Введите номер диска на
котором находится вносимый фильм", Title, , , , , , 1)

ActiveSheet.Cells(xls_line + 1, 1).Select

macros_cancel:
Response = MsgBox("Хотите добавить следующий фильм ?", vbYesNo +
vbDefaultButton2, Title)
If Response = vbYes Then
GoTo restart
End If

Response = MsgBox("Программа завершена...", vbInformation, Title)

macros_end:

End Sub

=== Конец Windows Clipboard ===

* Оригинал написан в FLASH.LOCAL
* Скопировано в MAGGOTS.COLONY
* Скопировано в MOONLIGHT.LOCAL

С уважением, Евгений.