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.
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