ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Problema na execução de Código em computador Diferente

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
W. Cavalcante
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Seg Jun 01, 2020 10:19 am

Problema na execução de Código em computador Diferente

Mensagem por W. Cavalcante » Sáb Jul 11, 2020 7:54 pm

Boa noite pessoal,

estou com um problema que está me tirando o sono.

Tenho uma aplicação onde utilizo VBA para copiar informações de uma planilha e inserir em um Site.
Utilizo Windows 10, x64
meu Office é o 2016 x64

muito bem, aqui roda tudo direitinho, tenho outro computador com o mesmo sistema acima que também roda igual.
o problema é que têm usurário que está tendo problemas com a aplicação utilizando o mesmo windows e o mesmo office. como pode?

Utilizo as APIs e Funções abaixo para Enviar Área de Transferência e Pegar dados da Área de transferência.
Anexo envio a imagem dos error;

Também ocorre o mesmo erro em uma parte bem simples do código, que da pra ver na imagem.. é apenas uma formatação.. e da erro lá tbm..


Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal lpShowCmd As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems

Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As LongPtr
Dim iLen As LongPtr
Dim iLock As LongPtr
Const GMEM_MOVEABLE As LongPtr = &H2
Const GMEM_ZEROINIT As LongPtr = &H40
Const CF_UNICODETEXT As LongPtr = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub

Function ClipBoard_GetData()
Dim hClipMemory As LongPtr
Dim lpClipMemory As LongPtr
Dim MyString As String
Dim RetVal As LongPtr

If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If

' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If

' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)

' Peel off the null terminating character.
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If

OutOfHere:

RetVal = CloseClipboard()
ClipBoard_GetData = MyString

End Function
Anexos
Anotação 2020-07-11 194552.png
Anotação 2020-07-11 194552.png (405.69 KiB) Exibido 702 vezes
Anotação 2020-07-11 194356.png
Anotação 2020-07-11 194356.png (364.04 KiB) Exibido 702 vezes



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder