di2847l1.txt
;***************************************************************************
;
; LISTING 1 - SAVE-CHARACTER EXCEL MACRO
;
; "Tricks improve on Excel LCD initialization," EDN, April 11, 2002, pg 68
;
;***************************************************************************
Sub SaveCharacter()
'
' SaveCharacter Macro
' Macro recorded 11/16/01 by Aubrey Kagan
'
' Keyboard Shortcut: Ctrl+Shift+T
'
'if file does not exist then create it.
    Dim sFname As String
    Dim sX As String
    Dim iPoint As Integer
    Dim sComment As String
    Dim iUtil As Integer
    Dim iFileExists As Boolean
    
    sFname = Range("A1").Value
    sFname = sFname & ".txt"
    
    sX = Dir(sFname)
    If sX <> "" Then
        iFileExists = True
    Else
        iFileExists = False
        Open sFname For Output As #1
        'take the comment symbols an place the file name as the first
        'comment
        
        sX = Range("B27").Value & sFname
        Print #1, sX
        Close #1
        'file created and saved
    End If
    'now we print a range of values across the page
    'associated with the bytes for the pixels
    iPoint = 24
    iPoint = iPoint - (Range("B4").Value - 1)
    sX = iPoint
    'converting typ to string
    sX = "R" & sX
    sX = sX & "C14"
    'pointing at the start of the data
    Application.Goto Reference:=sX
    
    'get character description
    sComment = InputBox("Enter you comment for this Character", "Comment Creation")

    Open sFname For Append As #1
    Print #1, Range("B26").Value;
    
    For iUtil = 0 To (Range("B4").Value - 1)
        sX = (iPoint + iUtil)
        sX = "R" & sX
        sX = sX & "C14"
        'placing the cursor at the data address
        Application.Goto Reference:=sX
        Print #1, ActiveCell.Value;
        Print #1, Range("B28").Value;
        'print value followed by the delimiter
    Next
    
    sComment = Range("B27").Value & sComment
    Print #1, sComment

    'ensure all files are closed
    Close
'as a final step clear the page for the next character
    Range("D9:M24").Select
    Selection.ClearContents
    'move to the top left hand of screen
    'first deal with rows
    iPoint = 24
    iPoint = iPoint - (Range("B4").Value - 1)
    sX = iPoint
    'type conversion
    sX = "R" & sX & "C"
    'concantenate for rows and add C for columns
    iPoint = 13
    iPoint = iPoint - (Range("B3").Value - 1)
    sX = sX & iPoint
    'should do the conversion as well
    Application.Goto Reference:=sX
    
End Sub