Enregistrer sous + lien hypertexte

Private Sub BtnValider_Click()
    Const wdDialogSaveAs = &H54
    Dim dlg
    Dim combo As String
       If ComboBox1.Value = "Devis vierge" Then
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
        Set wrdDoc = wrdApp.Documents.Add("D:\MODELE DEVIS\DEVIS.dot")
        With wrdDoc
            .Bookmarks("titre").Range _
                    .InsertBefore ComboBox12
            .Bookmarks("usine").Range _
                    .InsertBefore ComboBox11
            .Bookmarks("nom").Range _
                    .InsertBefore ComboBox10
            .Bookmarks("numdevis").Range _
                    .InsertBefore TextBox2
            .Bookmarks("lieu1").Range _
                    .InsertBefore ComboBox4
            .Bookmarks("lieu2").Range _
                    .InsertBefore ComboBox5
            .Bookmarks("lieu3").Range _
                    .InsertBefore ComboBox8
           End With
        With wrdApp
            wrdApp.ActiveDocument.SaveAs "D:\MODELE DEVIS\" & combo & ".dot"
    AppWord.Quit
            dlg.Show
        End With
     
        Set wrdApp = Nothing
    End If
 Unload DEVIS
End Sub

Private Sub CommandButton1_Click()
fin = 3
fin = Feuil2.Range("B1").End(xlDown).Row + 1
Feuil2.Rows(fin).Insert: Cells(fin, 1) = Cells(fin - 1, 1) + 1: Cells(fin, 2) = Cells(fin - 1, 2) + 1
Cells(fin, 9).FormulaR1C1 = "=SUM(RC[-1]*RC[-2])"
Cells(fin, 10).FormulaR1C1 = "=SUM(RC[-1]+RC[-5]+RC[-4])"
Cells(fin, 13).FormulaR1C1 = "=SUM(RC[-8]*1.31-RC[-8])"
With Range("A" & fin & ":l" & fin)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
End With
With DEVIS
  .ComboBox10.ControlSource = "DEVIS!K" & fin
  .ComboBox12.ControlSource = "DEVIS!C" & fin
combo = "DEVIS!C" & fin
   .TextBox1 = Feuil2.Cells(fin, 1)
  .TextBox2 = Feuil2.Cells(fin, 2)
  .Show
End With
DEVIS.Show
End Sub

wrdApp.ActiveDocument.SaveAs "D:\MODELE DEVIS\" & combo & ".dot"