400分求解：一个看似不复杂的打印问题。

[yassee]

看图比较直观些。

要求就是能一次性打出如图的效果。

我能做到打印一排，第二排却很难做到，因为打印机不能回打的，打完第一排第一个字，无法从新通过计算CurrentY,CurrentX来从打。

解决问题送400分。CSDN问题点数只能先给200.后再加。

[贝隆]

考虑把其防止到Excel中？录制宏得到代码，再根据这个代码编写代码，最后得到想要的效果，再执行打印功能即可。

[贝隆]

借用后台Excel文件，实现打印功能

Option Explicit
Dim xlsApp As Excel.Application      'Excel应用对象
Dim xlsBook As Excel.Workbook        'Excel工作薄对象
Dim xlsSheet As Excel.Worksheet      'Excel工作表对象
'Dim xlsWork As Excel.Workbook
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub Command1_Click()
    Set xlsApp = CreateObject("Excel.Application")
    Set xlsBook = xlsApp.Workbooks.Open("D:\1.xls", , False, , "", "")
    Set xlsSheet = xlsBook.Worksheets("Sheet1")
    xlsSheet.Activate
    xlsApp.Visible = False
    
    xlsSheet.Columns("A:A").ColumnWidth = 53.13
     xlsSheet.Columns("A:A").ColumnWidth = 7
     xlsSheet.Range("A2").Select
     xlsApp.ActiveCell.FormulaR1C1 = "中"
     xlsSheet.Range("A3").Select
     xlsApp.ActiveCell.FormulaR1C1 = "华"
     xlsSheet.Range("A4").Select
     xlsApp.ActiveCell.FormulaR1C1 = "人"
     xlsSheet.Range("A5").Select
     xlsApp.ActiveCell.FormulaR1C1 = "民"
     xlsSheet.Range("A6").Select
     xlsApp.ActiveCell.FormulaR1C1 = "gong"
     xlsSheet.Range("A6").Select
     xlsApp.Selection.ClearContents
     xlsApp.ActiveCell.FormulaR1C1 = "共"
     xlsSheet.Range("A7").Select
     xlsApp.ActiveCell.FormulaR1C1 = "和"
     xlsSheet.Range("A8").Select
     xlsApp.ActiveCell.FormulaR1C1 = "国"
     xlsSheet.Columns("A:A").Select
     xlsApp.Selection.ColumnWidth = 3
     xlsSheet.Cells.Select
     xlsApp.Selection.RowHeight = 30
     xlsSheet.Range("B2").Select
     xlsApp.ActiveCell.FormulaR1C1 = "人"
     xlsSheet.Range("B3").Select
     xlsApp.ActiveCell.FormulaR1C1 = "民"
     xlsSheet.Range("B4").Select
     xlsApp.ActiveCell.FormulaR1C1 = "万"
     xlsSheet.Range("B5").Select
     xlsApp.ActiveCell.FormulaR1C1 = "岁"
     xlsSheet.Range("B2:B5").Select
     xlsSheet.Columns("A:A").ColumnWidth = 5.25
     xlsSheet.Range("A2:A8").Select
    With xlsApp.Selection.Font
        .Name = "宋体"
        .FontStyle = "加粗"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     xlsSheet.Range("B2:B5").Select
     xlsSheet.Columns("B:B").ColumnWidth = 4.5
     xlsSheet.Range("B2:B5").Select
    With xlsApp.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
     xlsApp.Selection.Merge
     xlsSheet.Range("B2:B5").Select
     xlsApp.ActiveCell.FormulaR1C1 = "人民万岁"
     xlsSheet.Range("B2:B5").Select
     xlsApp.ActiveCell.FormulaR1C1 = "人" & Chr(10) & "民" & Chr(10) & "万" & Chr(10) & "岁"
    With xlsApp.ActiveCell.Characters(Start:=1, Length:=7).Font
        .Name = "宋体"
        .FontStyle = "常规"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
     xlsSheet.Range("B2:B5").Select
    With xlsApp.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
     xlsSheet.Range("D6").Select
    
     xlsSheet.PrintOut
     xlsSheet.SaveAs ("D:\1.xls")
     
     Sleep 1000
     
     Set xlsSheet = Nothing
    xlsBook.Close
    Set xlsBook = Nothing
    Set xlsApp = Nothing
End Sub

[yassee]

to chinaboyzyq:
难道跟打印机有关？您的方法我早就用过，也测试过，我的打印机打不出来。一个第一排大字，一个第一排小字。

[jhone99]

Private Sub Command1_Click()
    Dim i As Integer
    Dim strTemp1 As String
    Dim strTemp2 As String
    Dim m_X As Single
    Dim m_Y As Single
    
    On Error GoTo ERRPATH
    
    strTemp1 = "美丽夫人"
    strTemp2 = "大小多少"
    m_X = 10
    m_Y = 10
    
    Printer.ScaleMode = vbMillimeters   '数字单位 = mm
    
    Printer.FontBold = True
    Printer.FontSize = 30
    Printer.FontName = "宋体"
    For i = 1 To Len(strTemp1)
        Printer.CurrentX = m_X + 10
        Printer.CurrentY = m_Y + (i - 1) * 10
        Printer.Print Mid(strTemp1, i, 1)
    Next i
        
    Printer.FontBold = True
    Printer.FontSize = 12
    Printer.FontName = "宋体"
    For i = 1 To Len(strTemp2)
        Printer.CurrentX = m_X + 30
        Printer.CurrentY = m_Y + (i - 1) * 5
        Printer.Print Mid(strTemp2, i, 1)
    Next i
    
    Printer.EndDoc
    Exit Sub

ERRPATH:
    Printer.KillDoc
    MsgBox Err.Number & Err.Description
    
    
    
End Sub

[jhone99]

应该是你的代码具体控制出问题了

[咸清]

[Quote=引用 5 楼 cqq_chen 的回复:]

做成jpg,直接打印jpg
[/Quote]
bmp更现实啊

[贝隆]

哦，，重赏之下，必有勇夫哦。。
把你现有的打印代码贴出来？

[波导终结者]

打印位图

[yassee]

字体会很大很小，不能用printform做。
我printer实现打印一排简单。第2排不知道咋做。

[chinaboyzyq]

打印机对象是总体算完后，才开始打印的，不存在回打的问题。

复制以下代码去测试:

Private Sub Command1_Click()
  With Printer
  .CurrentX = 0
  .CurrentY = 0
  .Font.Size = 72
   
   For i = 1 To 5
  .CurrentX = 0
  Printer.Print "x"
  .CurrentY = .CurrentY - 800
   Next
   
  .Font.Size = 36
  .CurrentY = 72 * 4
   For i = 1 To 5
  .CurrentX = 800
  Printer.Print "x"
  .CurrentY = .CurrentY - 350
   Next
   .EndDoc
   
  End With
  
End Sub

[cqq_chen]

做成jpg,直接打印jpg

[chinaboyzyq]

没看到另一个200分在哪里。

[xxfly]

调用word、excel模板打印

[vansoft]

打印机是从上往下打，不是从左往右打。

[jhone99]

[Quote=引用 14 楼 vansoft 的回复:]
打印机是从上往下打，不是从左往右打。
[/Quote]

和打印机怎么打没有关系，程序控制是程序控制，你想几个字摞起来都没关系，enddoc后打印机爱怎么打怎么打

[熊孩子开学喽]

除非你是放在同一个字符串里面打,才会有位置问题.
你要是指定一个位置和字体大小打一个字的话, 随便你打什么位置都行