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 С уважением, Евгений.