vba

Sub ShowForm()
Dim CaseFiles(1000) As String
Dim i As Integer
Dim j As Integer
Dim CountFiles As Integer
Dim Duplicate As Boolean

CountFiles = 0
i = 2
While (ThisWorkbook.Sheets("data").Cells(i, 1).Value <> Null) Or (ThisWorkbook.Sheets("data").Cells(i, 1).Value <> "")
    Duplicate = False
    j = 1
    While (j <= CountFiles) And (Duplicate = False)
        If ThisWorkbook.Sheets("data").Cells(i, 1).Value = CaseFiles(j) Then Duplicate = True
        j = j + 1
    Wend

    If Not Duplicate Then
        CountFiles = CountFiles + 1
        CaseFiles(CountFiles) = ThisWorkbook.Sheets("data").Cells(i, 1).Value
        UserForm1.ComboBox1.AddItem CaseFiles(CountFiles)
    End If

    i = i + 1
Wend

UserForm1.ComboBox2.AddItem "level1"
UserForm1.ComboBox2.AddItem "level2"

UserForm1.Show


End Sub

Sub LoadTemplate(template As String, CaseFile As String)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim S As Word.Selection
Dim FPath As String
Dim CaseFileRow As Integer
Dim CaseFileFound As Boolean
Dim SearchString As String
Dim i As Integer

CaseFileFound = False
CaseFileRow = 2
While ((ThisWorkbook.Sheets("data").Cells(CaseFileRow, 1).Value <> Null) Or (ThisWorkbook.Sheets("data").Cells(CaseFileRow, 1).Value <> "")) And (Not CaseFileFound)
    If ThisWorkbook.Sheets("data").Cells(CaseFileRow, 1).Value = CaseFile Then
        CaseFileFound = True
    Else
        CaseFileRow = CaseFileRow + 1
    End If
Wend

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then 'Word isn't already running
    Set wdApp = CreateObject("Word.Application")
End If

On Error GoTo 0
'Open Template file
FPath = ThisWorkbook.Path
If FileExists(FPath + "\Templates", True) Then
    Set wdDoc = wdApp.Documents.Open(FPath + "\Templates\L____(" + template + ")_empty.docx")
Else
    Set wdDoc = wdApp.Documents.Open(FPath + "\L____(" + template + ")_empty.docx")
End If
wdApp.Visible = True

For i = 1 To 75
    If ThisWorkbook.Sheets("data").Cells(1, i).Value <> "" Then
        SearchString = "$" + FormatCellValue(ThisWorkbook.Sheets("data").Cells(1, i).Value) + "(" + ConvertToLetter(i) + ")$"
        With wdDoc.Range.Find
            .Format = True
            .Text = SearchString
            .Replacement.Text = ThisWorkbook.Sheets("data").Cells(CaseFileRow, i).Text
            .Replacement.Font.Color = RGB(0, 0, 0)
            .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
        End With
    End If
Next i


wdApp.WindowState = wdWindowStateMaximize
wdApp.Activate

FPath = FPath + "\L" + CaseFile + "(" + template + ").docx"
wdDoc.SaveAs FPath
End Sub

Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

Function FormatCellValue(Value As String) As String
Dim i As Integer
Dim Formated As Boolean

'For i = Len(Value) To 1
Formated = False
i = Len(Value)
While (i >= 1) And (Not Formated)
    If Mid(Value, i, 1) = " " Then
        i = i - 1
    Else
        Formated = True
        Value = Mid(Value, 1, i)
    End If
Wend

Formated = False
i = 1
While (i <= Len(Value)) And (Not Formated)
    If Mid(Value, i, 1) = " " Then
        i = i + 1
    Else
        Formated = True
        FormatCellValue = Mid(Value, i, Len(Value))
    End If
Wend
End Function

Private Function FileExists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean

On Error Resume Next
If sPathName <> "" Then
    If IsMissing(Directory) Or Directory = False Then
        FileExists = (Dir$(sPathName) <> "")
    Else
        FileExists = (Dir$(sPathName, vbDirectory) <> "")
    End If
End If
End Function