Newsgroup: it.comp.lang.visual-basic
Titolo: VB ed Excel - Forse il mio codice puo' essere di aiuto

Dopo aver rotto questo ng. con un mucchio di domande (stupide) , sono
riuscito finalmente a concludere il mio programma.
Essendo riconoscente alle persone che mi hanno aiutato con le loro risposte
, ho pensato di allegare il codice che ho sviluppato.
Penso possa essere utile a tutte quelle persone che come me hanno poca
esperienza nella programmazione VB
Naturalmente, se le persone piu' esperte hanno dei suggerimenti, questi
saranno graditi. :)
Saluto tutti
Marius
------------------------------------------------------------------
Obbiettivo del programma:
Il problema era quello di creare da VB un foglio EXCEL compilando poi una
tabella di Misure all'interno di esso.
Descrizione
Le misure vengono lette da uno strumento di misura (NEMO da me progettato)
che fornisce il valore di tensione e corrente tramite la porta seriale con
il protocollo MODBUS che e' uno dei piu' usati nell'ambito industriale.
Tutte le operazione di apertura , acquisizione e chiusura del foglio EXCEL
vengono eseguite utilizzando i tasti presenti sullo strumento. La tastiera
del PC e' utilizzata sono nella fase di introduzione dei parametri
essenziali al programma.
Le  fasi che il programma esegue sono 3:
            1)  Attesa pressione di un tasto ed apertura di un form che
richiede i dati essenziali ,
                apertura quindi del foglio EXCEL
            2) Aquisizione dati dallo strumento e compilazione della tabella
all'interno del foglio
            3) Chiusura del foglio EXCEL.
Ecco il codice.
-------------------- Codice -----------------------------
Private Sub Timer1_Timer()
 Dim ErrRx As Boolean
 Dim RxBuffer() As Byte
 Dim Index As Integer
 Dim StrTemp As String
 Dim Resp As Integer
 Static NomeFile As String
 Static XLApp As Object
 Static IndexMeasure As Integer
 Static PntFase As Integer
 On Error GoTo ErrorHandler
 Nemo_Key = 0
 ErrRx = JBus_ReadNWord(frmMain, ADDRMODBUS, &H301, 12, RxBuffer())
 If Not ErrRx Then
      Index = 0
      Nemo.V1 = GetJBLong(RxBuffer(), Index)
      Nemo.V2 = GetJBLong(RxBuffer(), Index)
      Nemo.V3 = GetJBLong(RxBuffer(), Index)
      Nemo.I1 = GetJBLong(RxBuffer(), Index)
      Nemo.I2 = GetJBLong(RxBuffer(), Index)
      Nemo.I3 = GetJBLong(RxBuffer(), Index)
      ErrRx = JBus_ReadNWord(frmMain, ADDRMODBUS, &HC, 1, RxBuffer())
      If Not ErrRx Then
        Index = 0
        Nemo_Key = GetJBInt(RxBuffer(), Index)
      End If
 End If
 ' Visualizzazione nella barra di stato
 If Not ErrRx Then
  frmMain.sbrStatus.Panels("Settings").Text = "[ V = " & CStr(Nemo.V2 /
1000) & " V]  " & "  [ I = " & CStr(Nemo.I2 / 1000) & " A]" & "   Key Code =
" & CStr(Nemo_Key) & "  "
 Else
  Nemo_Key = 0
  Nemo.V2 = 0
  Nemo.I2 = 0
  frmMain.sbrStatus.Panels("Settings").Text = "-Err.Com-"
 End If
 ' Gestione fasi di acquisizione dati
 Select Case PntFase
    '------------------ Attesa tasto Apertura nuova acquisizione dati
    Case 0
     If Nemo_Key <> NEMO_KEYUP Then
        frmMain.sbrStatus.Panels("Settings").Text =
frmMain.sbrStatus.Panels("Settings").Text & " Fase : ATTESA"
     Else
        frmMain.sbrStatus.Panels("Settings").Text =
frmMain.sbrStatus.Panels("Settings").Text & " Fase : IMPOSTAZIONE "
       'Resp = MsgBox("Tasto Up Premuto - Inizio richiesta", 0, "Tasti")
       frmDatiTrafo.Show vbModal
       If frmDatiTrafo.Responce Then
        ' Reset Eventuale Tasto premuto
        ErrRx = JBus_ReadNWord(frmMain, ADDRMODBUS, &HC, 1, RxBuffer())
        ' Dati inseriti correttamente apre foglio EXCEL ed aggiunge titolo
        NomeFile = DirExcel & DatiTrafo.strOrderNum & "_" &
DatiTrafo.strTAMatricola & ".xls"
        frmMain.sbrStatus.Panels("FileName").Text = "Nome File: " & NomeFile
        'NomeFile = "c:\documenti\Pippo.xls"
        On Error Resume Next
        Kill NomeFile
        On Error GoTo ErrorHandler
        Set XLApp = GetObject("", "Excel.Application")
        With XLApp
            .Visible = True
            .Workbooks.Add
            .Workbooks(1).Activate
            'crea una linea media attorno al titolo
            .Range("A1:F1").Select
            'unisco le celle
            With .Selection
                .HorizontalAlignment = -4108            'xlCenter
                .VerticalAlignment = -4107              'xlBottom
                .Merge
                .Font.Size = 14
                .Font.Bold = True
            End With
            'Inserire qui il titolo
            .Range("A1").Value = "I.M.E. S.p.A.  TEST TRASFORMATORE"
            .Range("G1:G1").Select
            With .Selection
                .Font.Size = 14
                .Font.Bold = True
            End With
            ' Inserire qui le intestazioni
            .Columns("A:A").ColumnWidth = 11.57
            .Range("A3:F3").Select
            With .Selection
                .HorizontalAlignment = -4108   'xlCenter
                .VerticalAlignment = -4107     'xlBottom
            End With
            .Columns("B:B").ColumnWidth = 30
            .Range("A3").Value = "Cliente"
            .Range("A4").Value = "'" & DatiTrafo.strClientName
            .Columns("B:B").ColumnWidth = 11.57
            .Range("B3").Value = "Data"
            .Range("B4").Value = "'" & DatiTrafo.strClientDate
            .Columns("C:C").ColumnWidth = 20
            .Range("C3").Value = "Numero Ordine"
            .Range("C4").Value = "'" & DatiTrafo.strOrderNum
            .Columns("D:D").ColumnWidth = 11.57
            .Range("D3").Value = "Data Ordine"
            .Range("D4").Value = "'" & DatiTrafo.strOrderDate
            .Columns("E:E").ColumnWidth = 11.57
            .Range("E3").Value = "Modello TA"
            .Range("E4").Value = "'" & DatiTrafo.strTAModel
            .Columns("F:F").ColumnWidth = 11.57
            .Range("F3").Value = "Portata"
            .Range("F4").Value = "'" & DatiTrafo.strTACurrent
            .Columns("G:G").ColumnWidth = 20#
            .Range("F3").Value = "Matricola"
            .Range("F4").Value = "'" & DatiTrafo.strTAMatricola
            .Range("C7:D7").Select
            With .Selection
                .HorizontalAlignment = -4108   'xlCenter
                .VerticalAlignment = -4107     'xlBottom
            End With
            ' Scrive intestazione Tabella Tensione/Corrente
            .Range("C7").Value = "Tensione (V)"
            .Range("D7").Value = "Corrente (A)"
            ' Disegna bordo tabella
            .Range("C7:D7").Select
            With .Selection.Borders(7)
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(8)
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(9)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(10)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(11)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
        End With
        ' Inizializza FlexGrid
        'InitFlexGrid
        ' Azzera Indice memorizzazione Misure
        IndexMeasure = 0
        StrTemp = "C" & CStr(IndexMeasure + 8)
        XLApp.Range(StrTemp).Select
        'Incrementa fase
        PntFase = PntFase + 1
       End If
     End If
    '---------------- Attesa tasti Acquisizione nuovo valore o chiusura
    Case 1
     frmMain.sbrStatus.Panels("Settings").Text =
frmMain.sbrStatus.Panels("Settings").Text & " Fase : ACQUISIZIONE"
     ' ********** Inserimento Nuovo Valore
     If Nemo_Key = NEMO_KEYDOWN Then
         'frDati.Visible = True
         DatiTrafo.Voltages(IndexMeasure) = Nemo.V2
         DatiTrafo.Currents(IndexMeasure) = Nemo.I2
         With XLApp
            StrTemp = "C" & CStr(IndexMeasure + 8)
            .Range(StrTemp).Value = CStr(Nemo.V2 / 1000)
            StrTemp = "D" & CStr(IndexMeasure + 8)
            .Range(StrTemp).Value = CStr(Nemo.I1 / 1000)
            ' Disegna bordo tabella
            .Range("C" & CStr(IndexMeasure + 8) & ":D" & CStr(IndexMeasure +
8)).Select
            With .Selection
              .HorizontalAlignment = -4152              ' xlRight
              .VerticalAlignment = -4107                ' xlBottom
            End With
            With .Selection.Borders(7)
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(8)
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(9)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(10)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            With .Selection.Borders(11)                  'xlEdgeBottom
                .LineStyle = 1                          'xlContinuous
                .Weight = 2                             'xlThin
                .ColorIndex = -4105                     'xlAutomatic
            End With
            .Selection.NumberFormat = "0.000"
        End With
        'Resp = MsgBox("Tasto DOWN Premuto - Acquisizione", 0, "Tasti")
        IndexMeasure = IndexMeasure + 1
        StrTemp = "C" & CStr(IndexMeasure + 8)
        XLApp.Range(StrTemp).Select
     End If
     ' *********** Chiusura foglio
     If Nemo_Key = NEMO_KEYENTER Then
       PntFase = PntFase + 1
     End If
    '---------------- Esportazione dati su foglio Exel
    Case 2
       frmMain.sbrStatus.Panels("Settings").Text =
frmMain.sbrStatus.Panels("Settings").Text & " Fase : SALVATAGGIO"
       With XLApp
        .ActiveWorkBook.SaveAs FileName:=NomeFile
        .Workbooks.Close
        .Quit
       End With
       Set XLApp = Nothing
       PntFase = 0
    Case Else
     PntFase = 0
 End Select
Exit Sub
'----------------------------------------
'   Routine di Gestione degli errori
'----------------------------------------
ErrorHandler:
    PntFase = 0
    Debug.Print Err.Number
    Select Case Err.Number
     Case 1004:
        Resp = MsgBox("   Errore accedendo al foglio Excel o salvando il
file    ", vbCritical, "Errore Oggetto Excel")
     Case Else
        Resp = MsgBox("Errore nel programma" & Err.Description, vbCritical,
"Errore")
    End Select
    'cerca di chiudere l'oggetto excel
    On Error Resume Next
    With XLApp
     '.ActiveWorkBook.Saved = True
     .Workbooks.Close
     .Quit
    End With
    Set XLApp = Nothing
End Sub

 wrote:
[CLIP]
Perché non prepari un progettino da pubblicare sul sito comune? Cosě mantiene la sua visibilitŕ e
potra esser utile anche a quelli che si sono persi questo tuo post... Che ne dici?
Ciao,
Moreno
#sirri#@#morenosoft#.com
(togliete "#" dall'indirizzo)
Moreno Sirri VB Site - 
http://www.morenosoft.com/MSVBSite/
---------------------------------------------------------------------------
Le risposte alle tue domande le trovi sul Sito Comune di questo NewsGroup:
 
http://www.murialdo.it/it_lang_vb
---------------------------------------------------------------------------

 Perché non prepari un progettino da pubblicare sul sito comune? Così
mantiene la sua visibilità e


Per favore mi dici come si fa?
Prepari un progettino d'esempio e lo invii al WebMaster del Sito Comune (
it_la...@murialdo.it
) con
una bella descrizione...
