OCRフォントの文字化け (ID:90170)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

コードを乗せます。
            'ヘッダ項目印字
            Printer.Font.Name = "ＭＳ 明朝"
            Printer.Font.Size = 11
            Printer.Font.Bold = False
            
            Prt "あいうえお", 5, 69, 0, False, 11, 198, True

Printer.Font.Name = "verdana"
            Printer.Font.Size = 11
            Printer.Font.Bold = False
            
            Prt "123456",5, 54

Printer.Font.Name = "ＭＳ 明朝"
            Printer.Font.Size = 11
            Printer.Font.Bold = False
            
            Prt "かきくけこ", 7, 69, 0, False, 11, 198, True

'***********************************************************************
'処理説明 : 印刷処理
'
'引数     : 1 sTxt     : 印字する文字列
'           2 nRow     : 印字位置(行)
'           3 nCol     : 印字位置(桁)
'           4 nLen     : 数値右詰めの際の印字文字数(省略時は0…文字列とみなす)
'           8 bFstrike : 取消線有りか? (省略時はFalse)
'           6 nFsize   : フォントサイズ      (省略時は11)
'           9 nFpitch  : ピッチ          (twips,省略時は144)
'           4 bKanji   : 日本語か?     (省略時はFalse)
'           5 sFname   : フォント名        (省略時は"ＭＳ 明朝")
'           7 bFbold   : 太字か?       (省略時はFalse)
'***********************************************************************
Private Sub Prt(sTxt, nRow, nCol, Optional nLen = 0, Optional bFstrike = False, Optional nFsize = 11, Optional nFpitch = 144, Optional bKanji = False, Optional sFname = "ＭＳ 明朝", Optional bFbold = False)
    Dim nCIdx
    Dim nStartX
    Dim nStartY
    Dim nStartLY
    Dim sPrtTxt As String
    Dim nComma  As Integer
    
    If Trim$(sTxt) = "" Then
        Exit Sub
    End If
     
    '印字開始位置
    nStartX = (nCol * U_Tpc) - (U_Tpc / 3)
    nStartY = (nRow * U_Tpr) + (U_Tpr / 2)
     
    Printer.CurrentY = nStartY
    Printer.CurrentX = nStartX
    
    If nLen > 0 Then
        '数値は右詰め
        If bKanji = False Then
            '"."(カンマ)を削除
            nComma = InStr(sTxt, ".")
            If nComma > 0 Then
                sTxt = Mid(sTxt, 1, nComma - 1) + Mid(sTxt, nComma + 1, Len(sTxt) - nComma)
            End If
            '先頭にスペースを付加
            While Len(sTxt) < nLen
                sTxt = " " + sTxt
            Wend
        Else
            '先頭にスペースを付加
            While Len(sTxt) / 2 < nLen
                sTxt = "  " + sTxt
            Wend
        End If
    End If
        
    '1文字ずつ印字
    For nCIdx = 1 To Len(sTxt)
'        Printer.Font.Name = sFname 'フォント名
'        Printer.Font.Size = nFsize 'フォントサイズ
'        Printer.Font.Bold = bFbold '太字
        
        Printer.Print Mid(sTxt, nCIdx, 1)
        
        If bFstrike = True Then
            '取消線
            If Mid(sTxt, nCIdx, 1) <> " " Then
                nStartLY = nStartY + ((U_Tpr / 5) * 2)
                Printer.DrawWidth = 1
                Printer.DrawMode = vbBlackness
                Printer.DrawStyle = vbSolid
                Printer.Line (nStartX, nStartLY)-(nStartX + nFpitch, nStartLY)
                nStartLY = nStartLY + (U_Tpr / 5)
                Printer.DrawWidth = 1
                Printer.DrawMode = vbBlackness
                Printer.DrawStyle = vbSolid
                Printer.Line (nStartX, nStartLY)-(nStartX + nFpitch, nStartLY)
            End If
        End If
        
        nStartX = nStartX + nFpitch '指定されたピッチ分横へ移動
        Printer.CurrentX = nStartX
        Printer.CurrentY = nStartY
    Next nCIdx
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る