Word online transcribe: Is there a way to group/combine same speaker instead of separate lines?

Question

Word online transcribe: Is there a way to group/combine same speaker instead of separate lines?

Kamrul Chowdhury 1

When transcribing from a audio, the same speaker over and over again. It would be nice if it can be grouped as a paragraph block. Is there any future plan to improve on this please?

LS 0 Reputation points

2023-08-16T14:25:41.1166667+00:00

Please let me know if you have found a solution?

Kamrul Chowdhury 1

I have developed a macro and it works for me. Please add this code block on your word document that contains those transcription and run the macro. Hope it helps:

Dim endPosition As Long

Sub Process_Speakers()
    On Error Resume Next
    Dim varData() As Variant
    
    If Selection.Type = wdSelectionIP Then 'If nothing selected then select everything
        Selection.WholeStory
    End If
    
    Dim speakerIndex As Long
    Dim totalSentences As Long
    Dim speakerLine
    Dim speakerLineTemp
    Dim speakerName As String
    Dim speakerNameTemp As String
    Dim speakerTime As String
    Dim xSelection As Selection
    Dim rTmp As Range
    Dim x As Long
    
    Dim totalCharCount As Long
    Dim totalSpeakerLineChar As Long
    Dim startPosition As Long
    Dim nameStartPosition As Long
    Dim MyRange As Range
    
    
    speakerIndex = 0
    nameStartPosition = 1
    totalSentences = Selection.Sentences.Count
    startPosition = 19
    endPosition = 0
    
    ReDim varData(totalSentences)
      
    For Each wordi In Selection.Sentences 'Loop through all sentences in selection
        totalSentences = totalSentences - 1
        totalCharCount = totalCharCount + Len(Trim(wordi))
        
        If (wordi Like "##[:]##[:]## *") And Len(wordi) > 10 Then 'Skip if not speaker line
            varData(speakerIndex) = Trim(wordi)
           
            totalSpeakerLineChar = totalSpeakerLineChar + Len(varData(speakerIndex))
            
            If speakerIndex > 0 Then
                numberOfSentence = numberOfSentence + 1
                speakerLine = Split(varData(speakerIndex))
                speakerTime = speakerLine(0)
                speakerName = speakerLine(1) + speakerLine(2)
                
                speakerLineTemp = Split(varData(speakerIndex - 1), " ")
                speakerNameTemp = speakerLineTemp(1) + speakerLineTemp(2)
               
            
                If (speakerName <> speakerNameTemp) Then
                   
                    totalCharCount = totalCharCount - Len(varData(nameStartPosition)) ' because it includes the next speaker line
                    totalSpeakerLineChar = totalSpeakerLineChar - Len(varData(nameStartPosition))
                    
                    Set MyRange = ActiveDocument.Range
                    MyRange.Find.Execute FindText:=varData(speakerIndex)
                    endPosition = MyRange.Start
                    
                    If (numberOfSentence > 1) Then
                        CombineSpeaker Selection, varData, speakerIndex, endPosition, startPosition, nameStartPosition 'call the procedure with parameters
                    End If
                    
                    numberOfSentence = 0
                    nameStartPosition = speakerIndex + 1
                    
                    Set MyRange = ActiveDocument.Range
                    MyRange.Find.Execute FindText:=varData(nameStartPosition - 1)
                    startPosition = MyRange.Start + Len(Trim(varData(nameStartPosition - 1)))
            
                    Selection.WholeStory
                    
                End If ' if speakername matches
                
            End If ' if i >0
                    
            speakerIndex = speakerIndex + 1
            
        ElseIf totalSentences = 0 Then
            
            If (numberOfSentence > 1) Then
                Set MyRange = ActiveDocument.Range
                MyRange.Find.Execute FindText:=wordi
                endPosition = MyRange.Start + Len(wordi) + 1
                varData(speakerIndex) = wordi
                
                CombineSpeaker Selection, varData, speakerIndex, endPosition, startPosition, nameStartPosition
            End If
        End If
    
    Next wordi
    
    ' End message
    If totalSentences <= 0 Then
            MsgBox "Transcribe: Combining the speaker is successful!", vbInformation, "Transcription combine"
    End If

End Sub

Sub CombineSpeaker(sel As Selection, varData() As Variant, speakerIndex As Long, endPosition As Long, startPosition As Long, nameStartPosition As Long)

    Selection.Start = startPosition
    Selection.End = endPosition
        
            Set xSelection = Application.Selection
            Dim index As Long

            index = nameStartPosition ' first one is the speaker name to keep
        
            For Each speakerTimeline In varData
                With xSelection.Find
                    .Text = varData(index)
                    .Replacement.Text = " "
                    .Execute Replace:=wdReplaceAll
                End With
                index = index + 1
                If (index >= speakerIndex) Then
                    Exit For
                End If
            Next speakerTimeline
            
            Selection.WholeStory
            Set MyRange = ActiveDocument.Range
            MyRange.Find.Execute FindText:=varData(speakerIndex)
            endPosition = MyRange.Start
           
            Selection.Start = startPosition
            Selection.End = endPosition
            xSelection.Paragraphs.Alignment = wdAlignParagraphJustify
             With xSelection.Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Forward = True
                    .Wrap = wdFindStop
                    .Format = False
                    .MatchAllWordForms = False
                    .MatchSoundsLike = False
                    .MatchWildcards = True
                    .Text = "([!^13])([^13])([!^13])"
                    .Replacement.Text = "\1\3"
                    .Execute Replace:=wdReplaceAll
                   
            End With
End Sub

2 answers

Your answer

LS 0 Reputation points

2023-08-16T14:25:41.1166667+00:00

Please let me know if you have found a solution?

Answer 1

Hi @Kamrul Chowdhury ,
If you have any feedback or suggestion about this behavior, you can try to give a feedback to Microsoft about your requirement:
https://support.microsoft.com/en-us/office/how-do-i-give-feedback-on-microsoft-office-2b102d44-b43f-4dd2-9ff4-23cf144cfb11
Microsoft values your opinion. Your feedback goes directly to our engineers and helps us shape the future of Microsoft products and services for all our users.

If the response is helpful, please click "Accept Answer" and upvote it.
Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

Answer 2

Jerry Asher 1

Yes, it would be good to be able to merge sections, and also to split sections when the transcription doesn't catch that the speaker has changed. When splitting a section, I would expect getting a new and accurate timestamp for where and when the split occurred, and of course a new speaker label.

LS 0 Reputation points

2023-08-16T14:26:14.96+00:00

Hi there, have you found any solutions as yet? If so , please share. Thanks

Share via

Word online transcribe: Is there a way to group/combine same speaker instead of separate lines?

2 answers

Your answer