Option Explicit
Private bCloseForm As Boolean
Private sDocumentStyles As String
Private sUsedDocumentStyles As String
Private sListedDocumentStyles As String
Dim sConstMsgTitle As String

Private Sub cmdAdd_Click()
Dim iCnt As Integer

On Error GoTo ErrorHandler
    
    If lstDocStyle.Text <> "" And lstProjectStyle <> "" Then
        lstMapStyle.AddItem lstDocStyle.Text & " --> " & lstProjectStyle.Text
        lstDocStyle.RemoveItem (lstDocStyle.ListIndex)
        For iCnt = 0 To lstDocStyle.ListCount - 1
            lstDocStyle.Selected(iCnt) = False
        Next iCnt
        For iCnt = 0 To lstProjectStyle.ListCount - 1
            lstProjectStyle.Selected(iCnt) = False
        Next iCnt
    End If
    Exit Sub
    
ErrorHandler:
    Err.Clear
    Resume Next
End Sub
Private Sub cmdApply_Click()
Dim i As Integer
Dim sDocStyle As String
Dim sProjectStyle As String
Dim iSplitPos As Integer
Dim rngFindArea As Range

    If lstMapStyle.ListCount <= 0 Then
        Exit Sub
    End If
    
    Call Format2Tag
    
    For i = 0 To lstMapStyle.ListCount - 1
        
        iSplitPos = InStr(1, lstMapStyle.List(i), " --> ")
        sDocStyle = Trim(Mid(lstMapStyle.List(i), 1, iSplitPos - 1))
        If InStr(1, sDocStyle, Chr(13)) > 0 Then
            sDocStyle = Trim(Replace(sDocStyle, Chr(13), ""))
        End If
        sProjectStyle = Trim(Mid(lstMapStyle.List(i), iSplitPos + 4, Len(lstMapStyle.List(i)) - 2))
        If InStr(1, sProjectStyle, Chr(13)) > 0 Then
            sProjectStyle = Trim(Replace(sProjectStyle, Chr(13), ""))
        End If
        
        If InStr(1, sDocumentStyles, "|" & sProjectStyle & "|") > 0 Then
            Call ApplyProjectStyles(sDocStyle, sProjectStyle)
        End If
        
    Next i
    
    Call Tag2Format
    
    MsgBox "Mapped styles has been changed in the document. Please ensure", vbInformation, sConstMsgTitle
    bCloseForm = True
    Unload Me
    Exit Sub
    
End Sub
Private Sub ApplyProjectStyles(sFindStyle As String, sReplaceStyle As String)
Dim rngDoc As Range

On Error GoTo ErrorHandler
    
    If sFindStyle = sReplaceStyle Then Exit Sub
    If sFindStyle = "Default Paragraph Font" Or sFindStyle = "Char Char" Or sFindStyle = "No List" Then Exit Sub
    Set rngDoc = ActiveDocument.Range
    With rngDoc.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Style = sFindStyle
        .Execute MatchWildcards:=False
        rngDoc.Select
        If rngDoc = ActiveDocument.Range Then Exit Sub
    End With
    
    Set rngDoc = ActiveDocument.Range
    With rngDoc.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Style = sFindStyle
        .Replacement.Style = sReplaceStyle
        .Execute MatchWildcards:=False, Replace:=wdReplaceAll
    End With
    Exit Sub
    
ErrorHandler:
    Err.Clear
    Resume Next
End Sub

Private Sub cmdClearAll_Click()
Dim iCnt As Integer
Dim DocSty As Style
Dim sCmpStr As String

    If lstMapStyle.ListCount <> 0 Then
        sListedDocumentStyles = ""
        If lstDocStyle.ListCount > 0 Then
            For iCnt = 0 To lstDocStyle.ListCount - 1
                sListedDocumentStyles = sListedDocumentStyles & lstDocStyle.List(iCnt) & "|"
            Next
            sListedDocumentStyles = "|" & sListedDocumentStyles
        End If
        If lstMapStyle.ListCount > 1 Then
            Do While lstMapStyle.ListCount <> 0
                lstMapStyle.ListIndex = 0
                sCmpStr = Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
                If InStr(1, sUsedDocumentStyles, "|" & sCmpStr & "|") > 0 And InStr(1, sListedDocumentStyles, "|" & sCmpStr & "|") = 0 Then
                    lstDocStyle.AddItem Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
                End If
                lstMapStyle.RemoveItem (lstMapStyle.ListIndex)
            Loop
        ElseIf lstMapStyle.ListCount = 1 Then
            lstMapStyle.ListIndex = 0
            sCmpStr = Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
            If InStr(1, sUsedDocumentStyles, "|" & sCmpStr & "|") > 0 And InStr(1, sListedDocumentStyles, "|" & sCmpStr & "|") = 0 Then
                lstDocStyle.AddItem Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
            End If
            lstMapStyle.RemoveItem (lstMapStyle.ListIndex)
        End If
    End If
End Sub

Private Sub cmdRemove_Click()
Dim iCnt As Integer
Dim bStylePresent As Boolean
Dim sCmpStr As String

On Error GoTo ErrorHandler
        If lstDocStyle.ListCount > 0 Then
            sListedDocumentStyles = ""
            If lstDocStyle.ListCount > 0 Then
                For iCnt = 0 To lstDocStyle.ListCount - 1
                    sListedDocumentStyles = sListedDocumentStyles & lstDocStyle.List(iCnt) & "|"
                Next
                sListedDocumentStyles = "|" & sListedDocumentStyles
            End If
        End If
    If lstMapStyle.ListCount > 1 Then
        If lstMapStyle.Text <> "" Then
            sCmpStr = Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
            If InStr(1, sUsedDocumentStyles, "|" & sCmpStr & "|") > 0 And InStr(1, sUsedDocumentStyles, "|" & sCmpStr & "|") = 0 Then
                lstDocStyle.AddItem Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
            End If
            lstMapStyle.RemoveItem (lstMapStyle.ListIndex)
            For iCnt = 0 To lstProjectStyle.ListCount - 1
                lstProjectStyle.Selected(iCnt) = False
            Next iCnt
        End If
    ElseIf lstMapStyle.ListCount = 1 Then
        lstMapStyle.ListIndex = 0
        sCmpStr = Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
        If InStr(1, sUsedDocumentStyles, "|" & sCmpStr & "|") > 0 And InStr(1, sListedDocumentStyles, "|" & sCmpStr & "|") = 0 Then
            lstDocStyle.AddItem Trim(Left(lstMapStyle.List(0), InStr(1, lstMapStyle.List(0), "-") - 1))
        End If
        lstMapStyle.RemoveItem (lstMapStyle.ListIndex)
    End If
    Exit Sub
    
ErrorHandler:
    Err.Clear
    Resume Next
End Sub

Private Sub UserForm_Initialize()
Dim DocSty As Style
Dim iCnt As Integer
Dim sSql As String
Dim sMappedStyles As String
Dim aMappedStyles() As String
Dim BookCode As String

sConstMsgTitle = "StyleMapper"

On Error GoTo ErrorHandler

    Call Module1.ePubStlyes

    For Each DocSty In ActiveDocument.Styles
        sDocumentStyles = sDocumentStyles & "|" & DocSty.NameLocal
        If IsStyleUsed(DocSty.NameLocal, True) Then
            If DocSty.Type <> wdStyleTypeCharacter Then
                lstDocStyle.AddItem DocSty.NameLocal & " " & Chr(13)
                sUsedDocumentStyles = sUsedDocumentStyles & DocSty.NameLocal & " " & Chr(13) & "|"
            Else
                lstDocStyle.AddItem DocSty.NameLocal
                sUsedDocumentStyles = sUsedDocumentStyles & DocSty.NameLocal & "|"
            End If
        End If
    Next DocSty
    
    sUsedDocumentStyles = "|" & sUsedDocumentStyles
    sDocumentStyles = sDocumentStyles & "|"
         
    BookCode = ""
    
    LoadProjectStyle
    
ErrorHandler:
    Err.Clear
    Resume Next
End Sub

''Private Sub LoadProjectStyle()
''Dim sFile As File, ReadFile As TextStream, sFilePath As String
''Dim lItemsCount As Integer
''Dim fso As FileSystemObject
''Dim sStyle As String
''
''    lItemsCount = 0
''
''    sFilePath = "D:\PUB\Styles.ini"
''
''    Set fso = New FileSystemObject
''    If fso.FileExists(sFilePath) Then
''        Set sFile = fso.GetFile(sFilePath)
''        Set ReadFile = sFile.OpenAsTextStream(ForReading)
''        Do While Not ReadFile.AtEndOfStream
''            sStyle = ReadFile.ReadLine
''            If InStr(1, sStyle, "|p") > 0 Then
''                sStyle = Trim(Left(sStyle, InStr(1, sStyle, "|p") - 1)) & " " & Chr(13)
''                frmStyleMapping.lstProjectStyle.AddItem sStyle
''            ElseIf InStr(1, sStyle, "|c") > 0 Then
''                sStyle = Trim(Left(sStyle, InStr(1, sStyle, "|c") - 1))
''                frmStyleMapping.lstProjectStyle.AddItem sStyle
''            End If
''            lItemsCount = lItemsCount + 1
''        Loop
''    Else
''       MsgBox "The " & sFilePath & " file does not exist in the specified path", vbInformation
''       Exit Sub
''    End If
''
''    If lItemsCount <= 0 Then
''      MsgBox "Please check, there is no styles present in Styles.ini file.", vbInformation
''        Exit Sub
''    End If
''
''End Sub


Private Sub LoadProjectStyle()
Dim sFile As File, ReadFile As TextStream, sFilePath As String
Dim lItemsCount As Integer
Dim fso As FileSystemObject
Dim sStyle As String
Dim sStyNam As String


Dim varRegex As New RegExp
Dim varMatch As Match
Dim varMatchs As MatchCollection

    lItemsCount = 0

    sFilePath = "D:\PUB\Styles.ini"

    Set fso = New FileSystemObject
    If fso.FileExists(sFilePath) Then
        Set sFile = fso.GetFile(sFilePath)
        Set ReadFile = sFile.OpenAsTextStream(ForReading)
        Do While Not ReadFile.AtEndOfStream
            sStyle = ReadFile.ReadLine
            
            varRegex.Pattern = "S Name: ([^\|\n]+)\|Type\: Para"
            
            If varRegex.Test(sStyle) = True Then
               Set varMatchs = varRegex.Execute(sStyle)
               Set varMatch = varMatchs(0)
               sStyNam = varMatch.SubMatches(0)
               sStyle = Trim(sStyNam) & " " & Chr(13)
               frmStyleMapping.lstProjectStyle.AddItem sStyle
               
            Else
                varRegex.Pattern = "S Name: ([^\|\n]+)\|Type\: Char"
                If varRegex.Test(sStyle) = True Then
                   Set varMatchs = varRegex.Execute(sStyle)
                   Set varMatch = varMatchs(0)
                   sStyNam = varMatch.SubMatches(0)
                   sStyle = Trim(sStyNam)
                   frmStyleMapping.lstProjectStyle.AddItem sStyle
                End If
                
                
            End If
            
            
''''            If InStr(1, sStyle, "|p") > 0 Then
''''                sStyle = Trim(Left(sStyle, InStr(1, sStyle, "|p") - 1)) & " " & Chr(13)
''''                frmStyleMapping.lstProjectStyle.AddItem sStyle
''''            ElseIf InStr(1, sStyle, "|c") > 0 Then
''''                sStyle = Trim(Left(sStyle, InStr(1, sStyle, "|c") - 1))
''''                frmStyleMapping.lstProjectStyle.AddItem sStyle
''''            End If
            lItemsCount = lItemsCount + 1
        Loop
    Else
       MsgBox "The " & sFilePath & " file does not exist in the specified path", vbInformation
       Exit Sub
    End If

    If lItemsCount <= 0 Then
      MsgBox "Please check, there is no styles present in Styles.ini file.", vbInformation
        Exit Sub
    End If

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If Not bCloseForm Then
        Cancel = -1
    Else
        'Application.Run macroname:="CancelWaitProcess"
    End If
End Sub


Public Function IsStyleUsed(sStyle As String, Optional NoPrompt As Boolean) As Boolean
   
    IsStyleUsed = False
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Style = sStyle
        .Replacement.Text = ""
        .MatchWildcards = False
        .Execute
        If .Found = True Then
            IsStyleUsed = True
        Else
            IsStyleUsed = False
        End If
    End With
End Function


Public Sub ClearFindAndReplaceParameters()
Selection.End = 0
    With Selection.Find
       .ClearFormatting: .Replacement.ClearFormatting
       .Text = "": .Replacement.Text = ""
       .Forward = True: .Wrap = wdFindStop
       .Format = False: .MatchCase = False
       .MatchWholeWord = False: .MatchWildcards = False
       .MatchSoundsLike = False: .MatchAllWordForms = False
    End With
    With Selection.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = " "
       .Execute
    End With
    Selection.End = 0
End Sub


cmdAdd
cmdRemove
cmdClearAll
cmdApply
lstDocStyle
lstICSStyle
lstMapStyle