Ответить

To Justas: Ну так замени fDC на hDC Printer.hDC  и сразу BitBLT на принтер без промежуточного PictureBox

To Sharp: ну извини, пожалуйста, блин

Ответить

Ответить

Ответить

Ответить

Ответить

А может не в Exel, a в Word? И там написать макрос, и скопировать макрос в программу? Я так рисовал, но только не грид, а свою таблицу и заполнял значениями из базы данных. И затем оттуда же (из Ворда ) печатал. Правда колонки были одинаковой ширины и если данные не влезали то  ячейка увеличивалась на 1 строку.Но информация не терялась. Конечно Exel наверное лучше, но я с ним не дружу. Никогда не пробовал.

А в Ворде примерно так:

Public Sub WORDDOC(arrCode As Variant, arrProduct As Variant, arrRash As Variant)
On Error GoTo lbl_err
frmMain.MousePointer = 13
Dim i As Long, R As Long, C As Long
Dim strPath As String
Dim Table1 As Object
    i = UBound(arrCode)
    Set WordApplication = CreateObject("Word.Application")
    Set WordApplicationDocuments = WordApplication.Documents.Add
    WordApplication.Visible = True
    With WordApplicationDocuments.Application.Selection.PageSetup
        .LeftMargin = 15
        .RightMargin = 15
        .TopMargin = 15
        .BottomMargin = 15
    End With
    With WordApplication
    .Selection.Font.Name = "Verdana"
Set Table1 = WordApplication.ActiveDocument.Tables.Add(WordApplication.ActiveDocument.Range(), 5 * (Int(UBound(arrCode) / 3) + 1), 3)
    For i = 1 To UBound(arrCode)
        C = (i - 1) Mod 3 + 1
        R = 5 * (Int((i - 1) / 3)) + 1
        .ActiveDocument.Tables(1).Cell(R, C).Select
        .Selection.Font.Bold = wdToggle
        .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Table1.Cell(R, C).Range.Text = "Магазин КОМПтовары"
       
        Table1.Cell(R + 1, C).Range.Text = "Наименование" & vbNewLine & vbNewLine & _
        arrProduct(i)
        .ActiveDocument.Tables(1).Cell(R + 1, C).Select
        .Selection.EndKey
       
        .Selection.MoveLeft wdCharacter, Len(arrProduct(i)), wdExtend
        .Selection.Font.Bold = wdToggle
        .ActiveDocument.Tables(1).Cell(R + 2, C).Select
        Table1.Cell(R + 2, C).Range.Text = "Цена    " & NormalPrice(CStr(arrRash(i)))
        .Selection.EndKey
        .Selection.MoveLeft wdCharacter, Len(NormalPrice(CStr(arrRash(i)))), wdExtend
        .Selection.Font.Bold = wdToggle
        .ActiveDocument.Tables(1).Cell(R + 3, C).Select
        .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Table1.Cell(R + 3, C).Range.Text = arrCode(i)
        .ActiveDocument.Tables(1).Cell(R + 4, C).Select
        .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        If Len(CStr(arrCode(i))) = 13 Then
            ФормаКод.Text1.Text = Left$(CStr(arrCode(i)), 12)
            ФормаКод.Command1_Click
            strPath = App.Path & "\EAN-" & ФормаКод.Text1.Text & ".bmp"
            If Dir(strPath) <> "" Then Kill strPath     'If file exists
            SavePicture ФормаКод.picEan.Image, strPath
            .Selection.InlineShapes.AddPicture Filename:=strPath
            Kill strPath
        Else
            Table1.Cell(R + 4, C).Range.Text = "Код не EAN - 13"
        End If
     Next i
   End With
   If Printers.Count <> 0 Then
    WordApplication.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
       PrintZoomPaperHeight:=0
    End If
    WordApplication.ActiveDocument.SaveAs "D:\1.rtf"
    Sleep 2500
    WordApplication.ActiveDocument.Close
    WordApplication.Quit
    WordApplication.Visible = False
    Kill "D:\1.rtf"
lbl_err:
    If err.Number = 429 Then
        MsgBox "Нет доступа к программе WORD", vbInformation
    End If
    frmMain.MousePointer = 0
End Sub

Попробуй, может чего полезного найдешь.

Ответить

Пасибо, может чего полезного и найду.

Только мне всё таки, ФлексГрид бы распечатать

Ответить