Can't GetObject to manipulate cells !?

lumolux@gmail.com

New member
Local time
Yesterday, 16:42
Joined
Apr 17, 2009
Messages
6
Hi guys,

I really don´t know where´s the mistake or mistery(?). This code have already worked for 5% of the atempts but usually 95% have not.
Part of the code is a an example of Microsoft.The other part is written in the area "manipulate your files here".
I want a module in MSAccess vb to do that:
Open a exel file eg:"teste.xls" to manipulate the worksheet "jyk" . If this file is aready opened I want to GetObject to manipulate the worksheet "jyk" in this file.When opening or by the first time either getttingobject, find the first blank cell in collumn "A2", copy "D1:F1" and then paste them to the place "A(Blank)".

Everybody thanks.

Code:
' Declara rotinas API necessárias:
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long

Function RunExcel()

       
   
   
   
    Dim MyXL As Object    ' Variável para conter a referência
                                ' ao Microsoft Excel.
  
      
    Dim ExcelWasNotRunning As Boolean    ' Sinalizador para
                                                    ' liberação final.

    Dim MySheet As Worksheet    ' Variável para conter a referência
                                'da planilha Excel.

' Testa para ver se já há uma cópia do Microsoft Excel sendo executada.
    On Error Resume Next    ' Adie a interceptação de erro.
' A função Getobject chamada sem o primeiro argumento returna uma
' referência para uma instânciato do aplicativo. Se o aplicativo não
' estiver executando, ocorre um erro.
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True
    Err.Clear    ' Limpe o objeto Err caso um erro ocorra.

' Se Microsoft Excel está executando,
' entre na tabela Objeto Executando.
    DetectExcel

' Defina a variável de objeto para fazer referência ao arquivo que você
' deseja ver.
    Set MyXL = GetObject("C:\teste.xls")
    Set MySheet = Worksheets("jyk")
'Chama Sub temporizador "Temp"
'Call Temp

' Exiba o Microsoft Excel através de sua propriedade Application. Então
' exiba a janela atual com o arquivo que usa a coleção do Windows
' da referência do objeto MeuXL.
    MyXL.Application.Visible = True
    MyXL.Parent.Windows(1).Visible = True
   
    'Manipulate your files here.
    ' ...

    'Copia e cola na primeira célula vazia
   
      'Copia e cola na primeira célula vazia
      ' Seleciona a Plan1
     
      MySheet.Activate
      MsgBox "The name of the active sheet is " & ActiveSheet.Name

      ' Posiciona na célula a ser copiada
      ActiveSheet.Range("d1:f1").Select
      ' copia
      ActiveSheet.Selection.Copy
      ' Seleciona a planilha de destino
      'Sheets("Plan2").Select
      ' posiciona na primeira célula
      ActiveSheet.Range("A2").Select
      ' posiciona na última usada
      ActiveSheet.Selection.End(xlDown).Select
      ' posiciona na primeira livre
      ActiveSheet.Offset(0, 0).Range("A2").Select
      ' cola
      ActiveSheet.Selection.Paste
      ' volta na planilha de origem dos dados
      'Sheets("Plan1").Select
   
      
' Se esta cópia do Microsoft Excel não estava sendo executada quando
' você iniciou, feche-a através do método Quit da propriedade
' Application.
' Observe que quando você tentar sair do Microsoft Excel,
' a barra de títulos fica intermitente e aparece uma mensagem perguntando
' se deseja salvar algum arquivo carregado.
   
    'If ExcelWasNotRunning = True Then
        'MyXL.Application.Quit
    'End If

    'Set MyXL = Nothing    ' Libere a referência ao
                                ' aplicativo e planilha.
 
End Function

       
     

Sub DetectExcel()
' O procedimento detecta um Excel sendo executado e o registra.
    Const WM_USER = 1024
    Dim hWnd As Long
' Se o Excel estiver sendo executado, esta chamada de API retorna seu
' gerenciamento.
    hWnd = FindWindow("XLMAIN", 0)
    If hWnd = 0 Then    ' 0 significa que o Excel não está em execução.
        Exit Sub
    Else
    ' O Excel está em execução; use a função de API SendMessage
    ' para inseri-lo na Tabela de objeto em execução.
        SendMessage hWnd, WM_USER + 18, 0, 0
    End If
attachment.php
 
I´ve got no error code, or code fail, simply the plan doesn´t change after the code runned.
In other words: The new cell´s(started with (A"1st blank cell") aren´t pasted with a copy of "D1:F1".

Obrigado.
 
Last edited:
I dunno if this is what you are trying to do, but try out this for you RunExcel. This finds the last row used and pastes the data from D1:F1 below it:

Code:
Option Explicit


Function RunExcel()

       
   
   
   
    Dim MyXL As Object    ' Variável para conter a referência
                                ' ao Microsoft Excel.
  
      
    Dim ExcelWasNotRunning As Boolean    ' Sinalizador para
                                                    ' liberação final.

    Dim MySheet As Worksheet    ' Variável para conter a referência
                                'da planilha Excel.
    Dim empty_row As Long

' Testa para ver se já há uma cópia do Microsoft Excel sendo executada.
    On Error Resume Next    ' Adie a interceptação de erro.
' A função Getobject chamada sem o primeiro argumento returna uma
' referência para uma instânciato do aplicativo. Se o aplicativo não
' estiver executando, ocorre um erro.
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True
    Err.Clear    ' Limpe o objeto Err caso um erro ocorra.

' Se Microsoft Excel está executando,
' entre na tabela Objeto Executando.
    DetectExcel

' Defina a variável de objeto para fazer referência ao arquivo que você
' deseja ver.
    Set MyXL = GetObject("C:\teste.xls")
    Set MySheet = Worksheets("jyk")
'Chama Sub temporizador "Temp"
'Call Temp

' Exiba o Microsoft Excel através de sua propriedade Application. Então
' exiba a janela atual com o arquivo que usa a coleção do Windows
' da referência do objeto MeuXL.
    MyXL.Application.Visible = True
    MyXL.Parent.Windows(1).Visible = True
   
    'Manipulate your files here.
    ' ...

    'Copia e cola na primeira célula vazia
   
      'Copia e cola na primeira célula vazia
      ' Seleciona a Plan1
     
      MySheet.Activate
      MsgBox "The name of the active sheet is " & ActiveSheet.Name
      
      ' Posiciona na célula a ser copiada
      MySheet.Range("D1:F1").Copy
      
      empty_row = MySheet.Range("A2").End(xlDown).Row
      
      MySheet.Range("A" & CStr(empty_row + 1)).Select
      
      MySheet.Paste
      
      ' cola
      Selection.Paste
      ' volta na planilha de origem dos dados
      'Sheets("Plan1").Select
   
      Set MySheet = Nothing
      
' Se esta cópia do Microsoft Excel não estava sendo executada quando
' você iniciou, feche-a através do método Quit da propriedade
' Application.
' Observe que quando você tentar sair do Microsoft Excel,
' a barra de títulos fica intermitente e aparece uma mensagem perguntando
' se deseja salvar algum arquivo carregado.
   
    'If ExcelWasNotRunning = True Then
        'MyXL.Application.Quit
    'End If

    'Set MyXL = Nothing    ' Libere a referência ao
                                ' aplicativo e planilha.
 
End Function
 
honda882000,

Your code had the same behavior like mine, nothing occours to the plan, nothing changes.
If it is possible, make a simple excel file with name path and aspect as the image I sent, run the code many times, then tell me if you saw the problem and what you think.

Thanks.
 

Users who are viewing this thread

Back
Top Bottom