Change Text Style

(defun c:CTS(/ *error* adoc sset userkey ApplyStyle CreateTextStyles)
    (vl-load-com) ;Load activex Support
    (defun *error* (s)
     (if adoc (vla-endundomark adoc))
  (if (not (member s '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\n---->Error:" s))
  )
  (princ)
 )
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq cmh (getvar 'cmdecho))
 (vla-startundomark adoc)
 (setvar 'cmdecho 0)
 ;;Apply Text Styles 
    (defun CreateTextStyles (name ttf)
       (if 
     (not (tblsearch "STYLE" name))
  (progn
      (if
       (or
        (member name '("ROMANS" "R"))
     (member name '("STANDARD" "S"))
    )
       (vl-cmdf "_.Style" name ttf "" "" "" "n" "n" "n")
       (vl-cmdf "_.Style" name ttf "" "" "" "n" "n")
      )
  )
 )
   )
   (defun ApplyStyle (ss sname / en i)
    (repeat (setq i (sslength ss))
     (setq en (vlax-ename->vla-object (ssname ss(setq i (1- i)))))
  (if (vlax-write-enabled-p en)
      (vlax-put-Property en 'StyleName sname)
  )
 )
)
 (if (setq sset (ssget '((0 . "TEXT,MTEXT"))))
     (progn
      (if (setq userkey (strcase (getstring "\nEnter New Style Name <ARial/Times Roman/Romans/STandard>:")))
       (progn
        (cond
         (  
          (or
           (or
            (= userkey "AR")
         (= userkey "A")
         (= userkey "ARIAL")
        )
       )
       (progn
           (createTextStyles "ARIAL" "Arial")
        (ApplyStyle sset "ARIAL")
       )
      )
         (
          (= userkey "T")
       (progn
           (CreateTextStyles "Times New Roman" "Times New Roman")
        (ApplyStyle sset "Times New Roman")
       )
      )
      (   
          (or
           (or
            (= userkey "ROMANS")
         (= userkey "R")
        )
       )
       (progn
           (CreateTextStyles "ROMANS" "Romans.shx")
        (ApplyStyle sset "ROMANS")
       )
      )
      (
          (or
           (or
            (= userkey "STANDARD")
         (= userkey "S")
         (= userkey "ST")
        )
       )
       (progn
           (CreateTextStyles "STANDARD" "Txt.shx")
        (ApplyStyle sset "STANDARD")
       )
      )
      (t
          (if (= userkey "")
              (princ "\nInvalid entry Try again.")
              (progn
                  (if (not (tblsearch "STYLE" userkey))
               (princ (strcat "\nText Style < " userkey " > not found!"))
               (ApplyStyle sset userkey)
           )
       )
            )
       
      )
     )
    )
   )
  )
  (*error* "non objects found!")
 )
 (vla-endundomark adoc)
 (princ)
)