[es] - msflexGrid u Excel

BlueSoniq
zaposlen / C#, ASP.NET senior
Beograd

Član broj: 11116
Poruke: 159
*.yubc.net

Profil

^{27.02.2004. u 09:48 - pre 249 meseci}

Pa probaj ovako:

Code:

Public Sub MSFExportToWord(ByRef nekimsflexgrid As MSFlexGrid, ByRef imedokumentazasnimanje)

'######################################################
'
'           DONE BY DEJAN  26.02.2002
'
'  Funkcija prebacuje ceo msf u neki word dokument i snima ga pod datim nazivom
'
'######################################################

On Error Resume Next

Dim worddoc As Word.Document
Dim wordApp As Word.Application

If IsMissing(nekimsflexgrid) Then Exit Sub

If nekimsflexgrid.Rows < 2 Then Exit Sub

Dim i As Long
Dim j As Long
Dim rkraj As Long
Dim kraj As Long
Dim bilajegreska As Long
Dim probasnimi As String

Dim brojace As Long

Dim snimifile As String

Set wordApp = CreateObject("Word.Application")
Set worddoc = wordApp.Documents.Add

On Error GoTo NEKAGRESKA

ActiveDocument.Range.Font.Name = "Arial"
ActiveDocument.Range.Font.Size = 22
ActiveDocument.Range.InsertAfter nekozaglavlje
ActiveDocument.Range.Font.Size = 18
ActiveDocument.Range.InsertAfter Chr(13) & Chr(10)
ActiveDocument.Range.InsertAfter Chr(13) & Chr(10)

ActiveDocument.Range.Font.Size = 12

For i = 1 To nekimsflexgrid.Rows - 1
    For j = 1 To nekimsflexgrid.Cols - 1
            ActiveDocument.Range.InsertAfter nekimsflexgrid.TextMatrix(i, j) & Space(6)
    Next j
            ActiveDocument.Range.InsertAfter vbCrLf
Next i

snimifile = imedokumentazasnimanje & ".doc"

Randomize

If Dir$(file & "\" & snimifile & ".doc") <> "" Then
      probasnimi = snimifile & Int((80 * Rnd) + 1)
      snimifile = snimifile & Int((80 * Rnd) + 1) & ".doc"
End If

If Dir$(file & "\" & snimifile) <> "" Then
If probasnimi = "" Then probasnimi = imedokumentazasnimanje
      snimifile = probasnimi & Int((80 * Rnd) + 1) & ".doc"
End If

ActiveDocument.SaveAs file & "\" & snimifile

ActiveDocument.Close
worddoc.Close
wordApp.Quit

    Set wordApp = Nothing

    If bilajegreska = 0 Then
        MsgBox "Uspesno uradjeno"
    Else
        MsgBox "Moguca greska prilikom snimanja u WORD"
    End If

Exit Sub

NEKAGRESKA:

If Err.Number <> 0 Then
    MsgBox "Moguca greska prilokom exporta - - " & Err.Description
End If

bilajegreska = Err.Number

    wordApp.Quit
    Set wordApp = Nothing
    Set worddoc = Nothing

End Sub

Odgovor na temu