Sub Main()
Dim objExcel As Object
Dim objWorkBook As Object
Dim objHojaExcel As Object
Dim objRangoHoja As Object
Dim objPalaRango As Object
Set objExcel = CreateObject("Excel.Application")Set objWorkBook = objExcel.Workbooks.Open("d:\....\Comandos.xlsm")Set objHojaExcel = objWorkBook.Sheets("Coman")
Set myRange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each aWord In myRange.Words
strWord = aWord.Text
aWord.Select
If Trim(strWord) <> "" Then
Select Case aWord.Font.Name
Case "Times New Roman"
subGuarda 2
Case "Arial"
subGuarda 3
Case "Courier New"
subGuarda 4
Case Else
'... etc
End Select
Else
Stop
End If
Next aWord
End Sub
'---------
Sub subGuarda(ByVal intColum As Integer)
''' subrutina solo de exposicion de idea...
'... no funciona
Dim intFila As Integer
intFila = 5
While Workbook("Comandos").worksheets("Coman").Cells(sinfila, intColum) <> "" If Workbook("Comandos").worksheets("Coman").Cells(sinfila, intColum) = strWord Then Exit Sub intFila = intFila + 1
Wend
Workbook("Comandos").worksheets("Coman").Cells(sinfila, intColum) = strWordEnd Sub
Crear cuenta
