Open Excel
On the Tools menu, point to Macro, and then click Visual Basic Editor (or Alt F11)
Copy text between the lines below:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Sub AudioCD_InsertTime()
Static S As String * 30
Dim Cmd As String
Dim Counter As Integer, Answer As Integer
Dim Min As Integer, Sec As Integer
Dim NrTracks As Integer, Track As Integer
Dim TrackLength() As String
Answer = MsgBox("The audio CD must already be in the CD-rom drive." & vbCrLf & _
"No other software may use the audio CD.", vbExclamation + vbOKCancel)
If Answer <> vbOK Then Exit Sub
mciSendString "close all", 0, 0, 0
mciSendString "open cdaudio alias cd wait shareable", 0, 0, 0
mciSendString "status cd number of tracks wait", S, Len(S), 0
NrTracks = CInt(Mid$(S, 1, 2))
ReDim TrackLength(1 To NrTracks)
Dim i As Integer
For i = 1 To NrTracks
Cmd = "status cd length track " & i
mciSendString Cmd, S, Len(S), 0
TrackLength(i) = S
Next i
Do
Counter = Counter + 1
Min = CInt(Mid$(TrackLength(Counter), 1, 2))
Sec = CInt(Mid$(TrackLength(Counter), 4, 2))
With ActiveCell.Cells(Counter, 1)
.Value = "00:" & Format(Min, "00") & ":" & Format(Sec, "00")
.NumberFormat = "[mm]:ss"
End With
If Counter = NrTracks Then Exit Do
Loop
mciSendString "close all", 0, 0, 0
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In the Visual Basic Editor:
Insert > Module
Paste the code.
Go back to Excel (use tab on Windows' Task bar) or close the Visual Basic Editor.
Put an audio CD in your CD ROM
Select any cell (suggest a cell on row 1 for this try out)
Then...... Tools > Macro > Macros (or Alt F8)
With your macro selected click
You can copy the cells and paste into any text document.
Save the workbook for use next time.
CREDITS : NFT TEAM
Posts
0 Comments