'为PR生成歌词或提示字幕SRT 'line1 1 序号 'line2 00:00:00,000 --> 00:00:02,000 时长 'line3 文本 'line4 空行 Const myFPS = 25
'视频每秒帧数 Const filename =
"F:\延时\荇菜\关雎0.SRT" 'SRT字幕文件名 Dim myTextList
'myTextList 为歌词，用半角逗号分隔,支持HTML myTextList=
"诗经·国风·周南〔先秦〕@0,关关雎鸠，在河之洲。@5:16,窈窕淑女，君子好逑。@9:16,参差荇菜，左右流之。@24:16-28:16" '@后 为每句字幕开始的时间，格式为时:分:秒:帧，前置时、分为0时可不写 '默认结束时间为下一句开始时间，如果不是，用-分隔加结束时间。最后一句必须有- '运行前，请先配置上面的参数 '在PR中导入时，请先在字幕导入设置中预先设定好样式 myTextList=Split(myTextList,
",")
Dim line,curText,curTime,SRTText
For line=0 To ubound(myTextList)
curText=split(myTextList(line),
"@")
curTime=split(curText(1),
"-")
If ubound(curTime)=1 Then
SRTText=SRTText & formatText(line+1,curTime(0),curTime(1),curText(0))
Else
SRTText=SRTText & formatText(line+1,curTime(0),split(split(myTextList(line+1),
"@")(1),
"-")(0),curText(0))
End if
Next
Call saveToFile(filename,SRTText,
"UTF-8BOM")
MsgBox line &
" SRT ok" Function formatText(line,startTime,endTime,strText)
formatText = line & Chr(13)&Chr(10) & formatTimeStr(startTime) &
" --> " & formatTimeStr(endTime) & Chr(13)&Chr(10) & strText & Chr(13)&Chr(10) & Chr(13)&Chr(10)
End Function Function byte2(n)
byte2 = Right(
"0" & CInt(n),2)
End Function Function formatTimeStr(TimeStr)
Dim i
TimeStr=Split(
"0:0:0:" & TimeStr,
":")
i=ubound(TimeStr)
formatTimeStr = byte2(TimeStr(i-3)) &
":" & byte2(TimeStr(i-2)) &
":" & byte2(TimeStr(i-1)) &
"," & Right(
"000" & int(1000*TimeStr(i)/myFPS),3)
End Function Function saveToFile(fn,str,charset)
'可生成UTF-8格式的文件 charset=GB2312 、UTF-8、 UTF-8BOM Dim objStream,newStream
Dim bom
If UCase(charset)=
"UTF-8BOM" Then
charset=
"UTF-8" bom=True
Else
bom=False
End if
Set objStream = CreateObject(
"ADODB.Stream")
objStream.Type = 2
'文本 1 二进制 objStream.Mode = 3
'读写 objStream.charset=charset
objStream.Open
objStream.writetext Str
If bom Then
objStream.saveToFile fn,2
Else
objStream.Position = 3
Set newStream = CreateObject(
"adodb.stream")
With newStream
.Mode = 3
.Type = 1
'二进制 .Open()
End With
objStream.CopyTo(newStream)
newStream.SaveToFile fn,2
newStream.close
End If
objStream.close
End Function