taisuke555のプロフィール

VB6でAPI(TextOut)を使って印刷する必要があるのですが、インターネットで調べたらサンプルがあってそれを参考にさせてもらおうと思っています。 ただ、当方としては、印刷位置と印刷文字サイズをmmで指定したく、色々試しているのですがうまくいきません。お分かりになる方どこがおかしいかご教示願えないでしょうか？ サンプルのソースコードを以下に張っておきます。formにCommandボタンを一つ張ってください。 Option Explicit Dim FX As Integer 'フォントの横サイズ Dim FY As Integer 'フォントの縦サイズ Dim cx As Long '表示X座標 Dim cy As Long '表示Y座標 Private Const DEFAULT_CHARSET = 1 Private Const OUT_DEFAULT_PRECIS = 0 Private Const DEFAULT_QUALITY = 0 Private Const DEFAULT_PITCH = 0 Private Const FF_DONTCARE = 0 Private Const LF_FACESIZE = 32 Private Type Size cx As Long cy As Long End Type Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(LF_FACESIZE) As Byte End Type Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As Size) As Long Private Sub Command1_Click() Printer.Print "" '文字印刷位置縦0mm 文字幅6mm、文字高6mmで印刷 FX = 6: FY = 6 cx = 0: cy = 0 PrintText "testてすと1" '文字印刷位置縦50mm 文字幅6mm、文字高12mmで印刷 FX = 6: FY = 12 cx = 0: cy = 50 PrintText "testてすと2" '縦倍角 '文字印刷位置縦200mm 文字幅12mm、文字高6mmで印刷 FX = 12: FY = 6 cx = 0: cy = 100 PrintText "testてすと3" '横倍角 Printer.EndDoc End Sub Sub PrintText(text As String) Dim LF As LOGFONT Dim IX As Integer Dim TempByteArray() As Byte Dim ByteArrayLimit As Long Dim OldFT As Long Dim NewFT As Long Dim rtn As Long Dim hdc As Long Dim PX As Long Dim PY As Long hdc = Printer.hdc '↓(1)ここで文字印刷位置をmmかTwipに変換しているつもりなのですが・・・ PX = Printer.ScaleX(cx, vbMillimeters, vbTwips) PY = Printer.ScaleY(cy, vbMillimeters, vbTwips) With LF .lfEscapement = 0 '文字の回転角度(角度*10) '↓(2)ここで文字サイズをmmかTwipに変換しているつもりなのですが・・・ .lfHeight = Printer.ScaleY(FY, vbMillimeters, vbTwips) '文字の高さ .lfWidth = Printer.ScaleX(FX, vbMillimeters, vbTwips) '文字の幅 .lfWeight = 400 '文字の太さ .lfItalic = False '斜体 .lfUnderline = False '下線 .lfStrikeOut = False '取り消し線 .lfCharSet = DEFAULT_CHARSET .lfOutPrecision = OUT_DEFAULT_PRECIS .lfClipPrecision = OUT_DEFAULT_PRECIS .lfQuality = DEFAULT_QUALITY .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE TempByteArray = StrConv("ＭＳ ゴシック", vbFromUnicode) ByteArrayLimit = UBound(TempByteArray) For IX = 0 To ByteArrayLimit .lfFaceName(IX) = TempByteArray(IX) Next End With NewFT = CreateFontIndirect(LF) OldFT = SelectObject(hdc, NewFT) TextOut hdc, PX, PY, text, LenB(StrConv(text, vbFromUnicode)) rtn = SelectObject(hdc, OldFT) rtn = DeleteObject(NewFT) End Sub 以上よろしくおねがいします。

シリアルプリンタの制御をVB6で行っております。 以下のようなコードですが、うまく終了してくれません。 'グローバル 'プリンタの状態 Dim BUF as String '起動時 Private Sub Form_Load() MSComm1.PortOpen = True Text1.Text = "" Timer1.Enabled = True End Sub '終了 Private Sub Form_Unload(Cancel As Integer) Timer1.Enabled = False MSComm1.PortOpen = False End Sub 'タイマー Private Sub Timer1_Timer() Timer1.Enabled = False Call CheckPrint Timer1.Enabled = True End Sub Private Sub MSComm1_OnComm() Dim TimeOut As Long Dim sTime As Long Dim eTime As Long Select Case MSComm1.CommEvent '受信 Case comEvReceive TimeOut = 100 sTime = timeGetTime Do If (TimeOut - eTime) < 0 Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until MSComm1.InBufferCount >= 82 BUF = MSComm1.Input End Select End Sub プリンタの状態チェック Private Sub CheckPrint() Dim sTime As Long Dim eTime As Long Dim TimeOut As Long Dim i As Integer Dim n As Integer BUF = "" 'プリンタの情報取得コマンド MSComm1.Output = "~HS" 'タイマ開始 TimeOut = 400 sTime = timeGetTime eTime = 0 Do DoEvents If BUF <> "" Then Exit Do End If eTime = (timeGetTime - sTime) Loop Until TimeOut - eTime < 0 If BUF <> "" Then ... .. 宜しくお願いします。

ａとｂがあります。 ３行目の値が１０以上の時のａとｂの個数をそれぞれ数えたい時の式はどのようにすればよいでしょうか？教えて下さい。Ｅ列はその答えです。 例）ａはＢ１に値を持たないのでＤ１のみの１になりますます。ｂはＢ２とＤ２で２になります。 　　　Ａ　　Ｂ　　Ｃ　　　Ｄ　　Ｅ １　　ａ　　　　　１　　　１　　１ ２　　ｂ　　１　　１　　　１　　２ ３　　　　１２　　８　　１１

以下の２つは同じ意味だと思うのですが、test2はエラーになります。どうしてなのでしょうか？ Sub test1() ActiveSheet.Shapes.AddShape(msoShapeRectangle, 300#, 100#, 140#, 80#).Select Selection.Formula = "$A$1" End Sub Sub test2() With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 300#, 100#, 140#, 80#) .Formula = "$A$1" End With End Sub

VBAでコメントにセルの値や変数の値を設定する処理はあるのですか？ よろしくお願いします。