[Resolvido]Colocar Imagens no bd

Olá,

Como faço para colocar uma imagem no fundo do bd access 2007, não é no form, mas naquele local geral da janela do bd quando você retira tudo (painel de navegação ribbons e fecha tudo só deixa a janela principal do bd. Como faço para inserir uma imgem ali?

Grato

Adilson

Não pode ser um formulário sem borda maximizado com a imagem no fundo?

Veja se dá:

Crie um novo Módulo no separador módulos

Option Compare Database
Option Explicit

' ****CODE START****
' Place this code in a standard module.
' make sure you do not name the module
' to conflict with any of the functions below.


'Author: Stephen Lebans
' Stephen@lebans.com
' www.lebans.com
' May 03, 2003
'
'Copyright: Lebans Holdings 1999 Ltd.
'
'Functions: See function declarations inline
'
'Dependencies:
' You must import the following modules into your own application in
' order for all of the functions contained in this project to work properly.
'
' modChangeMDI
' modColorPicker
' cDIBSection
' clsCommonDialog

'
'Credits: Nobody
'
'
'Why?: Somebody asked for it!
'
'What's Missing: User selectable props for scaling, position of Bitmap.
'
'BUGS: Let me know!
'
' NOTES: *****************************************************
' YOU MUST DELETE ANY BRUSHES YOU CREATE!
'
' :-)
Private Type RECT
Left As Long
top As Long
right As Long
Bottom As Long
End Type

Private Type SIZEL
cx As Long
cy As Long
End Type


Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgblReserved As Byte
End Type

Private Type BITMAPINFOHEADER '40 bytes
biSize As Long ' 40
biWidth As Long ' 32
biHeight As Long ' 64
biPlanes As Integer '1
biBitCount As Integer '1
biCompression As Long 'ERGBCompression
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type


Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGBQUAD
End Type


Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type



' Logical Brush (or Pattern)
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type

Private Type WNDCLASS
Style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra2 As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type




Type WNDCLASSEX
cbSize As Long
Style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
hIconSm As Long
End Type

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" _
Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" _
_
(ByVal crColor As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long


Private Declare Function GetStockObject Lib "gdi32" _
(ByVal nIndex As Long) As Long

Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateDIBPatternBrush Lib "gdi32" (ByVal hPackedDIB As Long, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" (lpPackedDIB As Any, ByVal iUsage As Long) As Long

Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long

Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long



Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long

Private Declare Function apiGetParent Lib "user32" _
Alias "GetParent" _
(ByVal hwnd As Long) _
As Long

Private Declare Function apiGetWindow Lib "user32" _
Alias "GetWindow" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) _
As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long


Private Declare Function apiSendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long


Private Declare Function RedrawWindow Lib "user32" _
(ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long


Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long


Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
(ByVal hInstance As Long, ByVal lpIconName As String) As Long

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As String) As Long

Private Declare Function GetClassInfo Lib "user32" Alias "GetClassInfoA" _
(ByVal hInstance As Long, ByVal lpClassName As String, lpWndClass As WNDCLASS) As Long


Private Declare Function GetClassInfoEx Lib "user32" Alias "GetClassInfoExA" _
(ByVal hInstance As Long, ByVal lpClassName As String, lpWndClass As WNDCLASSEX) As Long

' Class field offsets for GetClassLong() and GetClassWord()
Private Const GCL_MENUNAME = (-
Private Const GCL_HBRBACKGROUND = (-10)
Private Const GCL_HCURSOR = (-12)
Private Const GCL_HICON = (-14)
Private Const GCL_HMODULE = (-16)
Private Const GCL_CBWNDEXTRA = (-18)
Private Const GCL_CBCLSEXTRA = (-20)
Private Const GCL_WNDPROC = (-24)
Private Const GCL_STYLE = (-26)
Private Const GCW_ATOM = (-32)

' Window field offsets for GetWindowLong() and GetWindowWord()
Private Const GWL_WNDPROC = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_HWNDPARENT = (-
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_USERDATA = (-21)
Private Const GWL_ID = (-12)


' Stock Logical Objects
Private Const WHITE_BRUSH = 0
Private Const LTGRAY_BRUSH = 1
Private Const GRAY_BRUSH = 2
Private Const DKGRAY_BRUSH = 3
Private Const BLACK_BRUSH = 4
Private Const NULL_BRUSH = 5
Private Const HOLLOW_BRUSH = NULL_BRUSH


Private Const CLR_INVALID = &HFFFF

' Brush Styles
Private Const BS_SOLID = 0
Private Const BS_NULL = 1
Private Const BS_HOLLOW = BS_NULL
Private Const BS_HATCHED = 2
Private Const BS_PATTERN = 3
Private Const BS_INDEXED = 4
Private Const BS_DIBPATTERN = 5
Private Const BS_DIBPATTERNPT = 6
Private Const BS_PATTERN8X8 = 7
Private Const BS_DIBPATTERN8X8 = 8

' Hatch Styles
Private Const HS_HORIZONTAL = 0 ' -----
Private Const HS_VERTICAL = 1 ' |||||
Private Const HS_FDIAGONAL = 2 ' \\\\\
Private Const HS_BDIAGONAL = 3 ' /////
Private Const HS_CROSS = 4 ' +++++
Private Const HS_DIAGCROSS = 5 ' xxxxx
Private Const HS_FDIAGONAL1 = 6
Private Const HS_BDIAGONAL1 = 7
Private Const HS_SOLID = 8
Private Const HS_DENSE1 = 9
Private Const HS_DENSE2 = 10
Private Const HS_DENSE3 = 11
Private Const HS_DENSE4 = 12
Private Const HS_DENSE5 = 13
Private Const HS_DENSE6 = 14
Private Const HS_DENSE7 = 15
Private Const HS_DENSE8 = 16
Private Const HS_NOSHADE = 17
Private Const HS_HALFTONE = 18
Private Const HS_SOLIDCLR = 19
Private Const HS_DITHEREDCLR = 20
Private Const HS_SOLIDTEXTCLR = 21
Private Const HS_DITHEREDTEXTCLR = 22
Private Const HS_SOLIDBKCLR = 23
Private Const HS_DITHEREDBKCLR = 24
Private Const HS_API_MAX = 25

' Color Types
Private Const CTLCOLOR_MSGBOX = 0
Private Const CTLCOLOR_EDIT = 1
Private Const CTLCOLOR_LISTBOX = 2
Private Const CTLCOLOR_BTN = 3
Private Const CTLCOLOR_DLG = 4
Private Const CTLCOLOR_SCROLLBAR = 5
Private Const CTLCOLOR_STATIC = 6
Private Const CTLCOLOR_MAX = 8 ' three bits max

Private Const COLOR_SCROLLBAR = 0
Private Const COLOR_BACKGROUND = 1
Private Const COLOR_ACTIVECAPTION = 2
Private Const COLOR_INACTIVECAPTION = 3
Private Const COLOR_MENU = 4
Private Const COLOR_WINDOW = 5
Private Const COLOR_WINDOWFRAME = 6
Private Const COLOR_MENUTEXT = 7
Private Const COLOR_WINDOWTEXT = 8
Private Const COLOR_CAPTIONTEXT = 9
Private Const COLOR_ACTIVEBORDER = 10
Private Const COLOR_INACTIVEBORDER = 11
Private Const COLOR_APPWORKSPACE = 12
Private Const COLOR_HIGHLIGHT = 13
Private Const COLOR_HIGHLIGHTTEXT = 14
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_GRAYTEXT = 17
Private Const COLOR_BTNTEXT = 18
Private Const COLOR_INACTIVECAPTIONTEXT = 19
Private Const COLOR_BTNHIGHLIGHT = 20



Private Const WM_SYSCOLORCHANGE = &H15


' GetWindow() Constants
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

Private Const Title = ""
Private Const API_TRUE As Long = 1&
' Handle to original WINDOWCLASS Brush for MDI window
Private prevHBrush As Long
' Handle to our new Brush for the MDI window
Private hBrush As Long

' Handle to MDI window
Private HwndMDI As Long


' Handle to original WINDOWCLASS Brush for MDI window
Private prevHBrushStatus As Long
' Handle to our new Brush for the MDI window
Private hBrushStatus As Long







Public Function SetMDIBackGroundImage(Optional fName As String = "") As Boolean
' junk var
Dim lngRet As Long
Dim hBrushImage As Long
Dim hBrushImagePrev As Long

' Window Rect
Dim rc As RECT
' An instance of our DIBSection calss
Dim ds As New cDIBSection

If Len(fName & vbNullString) = 0 Then
' Call File Dialog
fName = ds.FileDialog(True)
End If
' Load the Bitmap file selected and create a DIBSection
' based on this Bitmap.
ds.Load fName

' Create a brush from the Bitmap we loaded
hBrushImage = CreatePatternBrush(ds.hDib)

' find MDIClient first
HwndMDI = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", Title)
' Get current dimensions
lngRet = GetWindowRect(HwndMDI, rc)

With rc
.Bottom = .Bottom - .top
.top = 0
.right = .right - .Left
.Left = 0
End With
hBrushImagePrev = SetClassLong(HwndMDI, GCL_HBRBACKGROUND, hBrushImage)
' Force a redraw
Call InvalidateRect(HwndMDI, rc, API_TRUE)
SetMDIBackGroundImage = True

' Cleanup
' Delete old brush
lngRet = DeleteObject(hBrushImagePrev)
Set ds = Nothing
End Function


Public Function RestoreMDIBackGroundImage(Optional crColor As Long = -1) As Boolean
' junk var
Dim lngRet As Long
Dim hBrushImage As Long
Dim hBrushImagePrev As Long

' Window Rect
Dim rc As RECT
' An instance of our DIBSection calss

If crColor <> -1 Then
hBrushImage = CreateSolidBrush(crColor)
Else
' Create a brush from the Bitmap we loaded
hBrushImage = CreateSolidBrush(GetSysColor(COLOR_APPWORKSPACE))
End If

' find MDIClient first
HwndMDI = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", Title)
' Get current dimensions
lngRet = GetWindowRect(HwndMDI, rc)

With rc
.Bottom = .Bottom - .top
.top = 0
.right = .right - .Left
.Left = 0
End With
hBrushImagePrev = SetClassLong(HwndMDI, GCL_HBRBACKGROUND, hBrushImage)
' Force a redraw
Call InvalidateRect(HwndMDI, rc, API_TRUE)
RestoreMDIBackGroundImage = True

' Cleanup
' Delete old brush
lngRet = DeleteObject(hBrushImagePrev)
End Function








Public Function SetStatusBackGround(ByVal BGColor As Long, Optional TextColor As Long = -1) As Boolean
' I tried to set a nwe Brush for the default BackGround brush for this
' window class but Access did not respect this change. I noticed that this window class
' is spec'd to have its own Device Context for each instance of the class so I
' decided to modify the DC's props directly.

' junk var
Dim lngRet As Long

' Window Rect
Dim rc As RECT
' This window's Device Context
Dim hDC As Long

' Handle to Status window
Dim hWndStatus As Long

' The Status Bar's window handle
hWndStatus = FindWindowEx(Application.hWndAccessApp, 0&, "OStatbar", vbNullString)

' Get current dimensions of the Status Bar window
lngRet = GetWindowRect(hWndStatus, rc)

With rc
.Bottom = .Bottom - .top
.top = 0
.right = .right - .Left
.Left = 0
End With

' Let's set the DC's properties directly
hDC = GetDC(hWndStatus)
' Set the Background Color of this DC
lngRet = SetBkColor(hDC, BGColor)
' Were we passed a new forecolor for the Text?
If TextColor <> -1 Then
lngRet = SetTextColor(hDC, TextColor)
End If

' Always release the DC ASAP
lngRet = ReleaseDC(hWndStatus, hDC)

' Force a redraw
Call InvalidateRect(hWndStatus, rc, API_TRUE)
SetStatusBackGround = True
End Function


Public Function RestoreStatusBackground() As Boolean
' Restore to default colors

' junk var
Dim lngRet As Long

Dim ButtonFaceColor As Long
' Window Rect
Dim rc As RECT
' This window's Device Context
Dim hDC As Long
' Handle to Status window
Dim hWndStatus As Long

' Current system color
ButtonFaceColor = GetSysColor(COLOR_BTNFACE)

' The Status Bar's window handle
hWndStatus = FindWindowEx(Application.hWndAccessApp, 0&, "OStatbar", vbNullString)

' Get current dimensions of the Status Bar window
lngRet = GetWindowRect(hWndStatus, rc)

With rc
.Bottom = .Bottom - .top
.top = 0
.right = .right - .Left
.Left = 0
End With

' Let's set the DC's properties directly
hDC = GetDC(hWndStatus)
' Set the Background Color of this DC
lngRet = SetBkColor(hDC, ButtonFaceColor)
' Set Text ForeColor to BLACK
lngRet = SetTextColor(hDC, 0)

' Always release the DC ASAP
lngRet = ReleaseDC(hWndStatus, hDC)

' Force a redraw
Call InvalidateRect(hWndStatus, rc, API_TRUE)
RestoreStatusBackground = True
' Force a redraw
Call InvalidateRect(hWndStatus, rc, API_TRUE)

RestoreStatusBackground = True
End Function





Private Function FindDetailWindow(ByVal frmhWnd As Long) As Long
' The Detail Window is always the second of three
' windows of class OFormSub.
' 1) Form Header
' 2) Detail
' 3) Footer


Dim hWnd_VSB As Long
Dim hwnd As Long
Dim ctr As Long

ctr = 0
hwnd = frmhWnd

' Let's get first Child Window of the FORM
hWnd_VSB = apiGetWindow(hwnd, GW_CHILD)

' Let's walk through every sibling window of the Form
Do
' Thanks to Terry Kreft for explaining
' why the apiGetParent acll is not required.
' Terry is in a Class by himself! :-)
'If apiGetParent(hWnd_VSB) <> hWnd Then Exit Do

If fGetClassName(hWnd_VSB) = "OFormSub" Then
ctr = ctr + 1
If ctr = 2 Then
FindDetailWindow = hWnd_VSB
Exit Function
End If

End If

' Let's get the NEXT SIBLING Window
hWnd_VSB = apiGetWindow(hWnd_VSB, GW_HWNDNEXT)

' Let's Start the process from the Top again
' Really just an error check
Loop While hWnd_VSB <> 0

' SORRY - NO Vertical ScrollBar control
' is currently visible for this Form
FindDetailWindow = 0
End Function


' From Dev Ashish's Site
' The Access Web
' http://www.mvps.org/access/

'******* Code Start *********
Private Function fGetClassName(hwnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
strBuffer = Space$(MAX_LEN)
lngLen = apiGetClassName(hwnd, strBuffer, MAX_LEN)
If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
'******* Code End *********

Cole o código

Agora no form

Ao carregar

SetMDIBackGroundImage ("C:\11.bmp")

Boa tarde,

O código do vieira, começou a dar alguns problemas (me sentir tão pequeno quando vi tanto código (risos)). Parei para ver se serei capaz de depurar com mais calma.

A opção do Criquio parece mais simples para mim trabalhar pela minha inexperiência em constantes VBA, porém tenho um forminicio onde antes de todos os outros, então colocando uma imagem no fundo de um form que já fiz como ele irá aparecer lá atrás, os outros forms são todos pop-up.

Grato,

ADilson

Você tem que ter uma imagem para servir de fundo. Se colou o código no módulo, nem precisa de dar-se ao trabalho de o ler e depois no form é só chamar a imagem conforme enviado. Eu uso e não dá nenhum problema. Faça o que for melhor e mais fácil.

O erro que tem nas linhas de codigo que Vieira mandou é:

Private Const GCL_MENUNAME = (-Cool) 'tem uma imagem e no vba vem (-cool).

Adilson

Você pode copiar o módulo e ver muito código a partir daqui.

ModChangeMDI

e tem muito mais. Divirta-se amigão

http://dl.dropbox.com/u/8157744/Unigest4.rar

Acho que seria bom o amigo Vieira desabilitar os smiles e html na mensagem. Isso mudou alguns caracteres no código

É isso Criqui, pelos vistos já não é a first time. No entanto enviei ao colega de outra forma. Thanks a Lot mineiro

Olá

a seguinte linha de comando está acusando erro

Dim ds As New cDIBSection

na função:

Public Function SetMDIBackGroundImage(Optional fName As String = "") As Boolean

o que faço?

Olá

Veja esta outra opção se lhe atende.

http://www.usandoaccess.com.br/dicas/dica13.asp?id=1#inicio

Sucesso!

No meu vba em referencias não tem a dll fondoaccess.dll, o que faço.


Adilson

Amigão, você terá que registrar esta dll...

Blz fiz isso. importei para o meu projeto, mas anda dando uns erros.

não aparece as imagens no form etc.


valeu

vou verificar com mais cuidado e ver o que tá acontecendo, vou descansar.

brigadão, amigão


Amanhã vemos isso


Adilson

Voce tem que registrar a dll, não apenas copiar...

Bom dia,

Registrei a dll pelo executar, ela está na pasta fundo que vem o bd, mas agora está aconteçendo alguns erros, que pelo que vi terei que alterar alguns situações na minha tabela de imagens e na codificação, creio que consigo fazer.
Agora tenho outras prioridades junto ao meu cliente a respeito do programa que estou desenvolvendo.

Portanto, agradeço a ajuda pois resolveu meu problema. Voces me ajudaram a solucionar meu problema, já sei como resolver graças a sua ajuda.


Atenciosamente,

Adilson

Um detalhe, para funcionar, terá que as imagens estarem num campo anexo na tabela. Dê uma boa olhada no bd exemplo disponibilizado pelo Avelino...

Rapaz de repente bateu uma vontade de mexer no sistema. (risos). está acontecendo um erro na seguinte linha de codigo que estou tentando resolver:

Me.Idimg = Me.ImgFundo.CurrentAttachment


o que será


Adilson

Será que os nomes dos campos estão corretos?
Para registrar a dll seria mais ou menos assim:
regsvr32.exe c:\CaminhoDaDll\fondoaccess.dll

Veja direitinho, pois eu uso esse método e é 100% funcional

a dll regitrou direitinho

regsvr32.exe f:\fundo\fondoaccess.dll

e apareceu a mensagem de registrado com êxito, mas acho que o problema é com a tbl, pois tem vários nome de imagens adicionadas no campo imgfundo e não tem na pasta fundo imagens
como faço para adicionar campos a tabela?

Adilson

Criar campo na tabela? Apenas abrir a tabela no modo Disigner e nomear uma linha vazia da tabela e definila como Anexo.

que tipo de dados coloco?

Adilson

Anexo

não tem esse tipo de dados anexo no meu access.
tem assistente de pesquisa, objeto ole, etc.

Amigão, vc usa qual access? Pois nunca usei versão anterir, mas se for 2007 tem sim!
Quando você abre a combo tipo de dados, é o Terceira de baixo pra cima...

meu access é 0 2007.


veja aí esta imagem da minha tabela

http://dl.dropbox.com/u/37804873/anexo.JPG

Adilson

Barão eu descobrir que meu access estava na versão 2003 mas usando no 2007.
aapreceu o tipo de dados anexo.

Adilson

Estava no 2003 e usando no 2007
Para o 2003 não posso te ajudar nesta questão, visto nunca ter usado, ja no 2007 em diante posso continuar te ajudando...

Já converti para o 2007, e depois de ter criado o campo imagem - anexo o que faço?

Adilson

O melhor que voce faz é importar todos os objetos do exemplo do Avelino (tabela, modulo e form). Apenas fazendo isso ja irá funcionar (consderando voce ja ter registtrado a dll FundoAccess).
Caso não consiga fazer funcionar, e vc quizer, posso fazer um accesso remoto no seu pc e voce verá eu fazendo e funcionando. (Se voce fizer exatamente como está no artigo que o Avelino te passou, não tem como dá errado)

De qualquer forma, se quiser, faço pra vc!

Olhe só eu importei tudo do exemplo de Avelino, talvez seja eu mesmo que não esteja pegando. posso passar o link para você garregar o bd aí e depois me passa para eu ver o que você fez.

http://dl.dropbox.com/u/37804873/Administrativo%20DEJOSAN.accdb

se puder me passe seu msn, só fico online. Gostaria de poder te-lo como contato do msn.

Agradeçido pela ajuda.

Adilson

Amigão, voce tem uma cópia do seu banco de dados sem ter importado os objetos do Avelino, se tiver, disponibilize aqui, pois está está com os códigos do FundoAccess por todos forms.

Fico no aguardo

Ainda tá no formato mdb, é só vc abrir e salvar como 2007.

http://dl.dropbox.com/u/37804873/Administrativo%20DEJOSAN.rar

Adilson

Aí está.
Descompact e teste exatamente como está. POderá alterar as imagens atravéz do form "frmImgFundo". É só mudar o anexo.

Vou almoçar agora e caso voce tenha alguma dúvida, as 13 h estarei de volta


Clique aqui para baixar

Está tudo ótimo grande Mestre, porém só com um pequenino problema:

está linha de código causa erro quando vou excluir uma imagem

Kill fncLocalFundo & "*.gif"

pois pelo que vejo ele só aceita formato gif, gostaria de permitir outros formatos como png, jpeg etc. o que tenho que fazer?

Adilson

É melhor não usar o kill neste caso, pois, o próprio campo anexo ja tem uma opção nativa do access para excluir.
E os anexos no access 2007 aceitam os seguintes formatos de imagem:

BMP (bitmap do Windows)

RLE (Run Length Encoded Bitmap)

DIB (Device Independent Bitmap)

GIF (Graphics Interchange Format)

JPEG, JPG, JPE (Joint Photographic Experts Group)

EXIF (Exchangeable File Format)

PNG (Portable Network Graphics)

TIFF, TIF (Tagged Image File Format)

ICON, ICO (Icon)

WMF (metarquivo do Windows)

EMF (metarquivo aprimorado)


Se voce der um clic em cima da imagem no form "frmImgFundo" irá abrir um menu nativo do access. Nele há as opções de mudar de imagem, adcionar ou excluir. E como viu, os formatos são bem diversificados, tranquilamente irá lhe atendar.

E qual a mudança então que devo fazer nesta função:

Private Function fncGravaFundo()
Dim rsfrm As DAO.Recordset2
Dim rsFilho As DAO.Recordset2
Dim fld As Field2

Set rsfrm = Me.Recordset
Set rsFilho = rsfrm.Fields("imgFundo").Value
Set fld = rsFilho.Fields("filedata")
Do While Not rsFilho.EOF
If rsFilho.AbsolutePosition = Idimg Then
If Len(Dir(fncLocalFundo, vbArchive) & "") > 0 Then
Kill fncLocalFundo & "*.gif"
End If
fld.SaveToFile (fncLocalFundo)
End If
rsFilho.MoveNext
Loop
Set fld = Nothing
Set rsFilho = Nothing
Set rsfrm = Nothing
End Function


Tá vendo onde o Kill está?


o que fazer?

Adilson

Isso tem a ver com local onde está execultando o bd.
Quando vc extrae ele cria uma pasta "Fundo", dentro da pasta fundo. Exclua uma pasta, subindo um nível. Assim, quando abrir a pasta fundo, verá que ja tem seu bd. É só usar...

Não gerou mais o erro, porém não aparece a imagem.
Tenho que reiniciar o bd para aparecer a imagem no fundo.
Tô quase desistindo, deu erro na seguinte linha


fld.SaveToFile (fncLocalFundo)



Adilson

Terá clicar em "gravar fundo"

Aqui não aparece erro algum...

Se voce quiser faço um acesso remoto aí... É sí vc baixar o Team Viewer do linque abaixo (versão free)

e me informar seu ID e senha...
Assim vejo aí no seu pc o erro ocorrer...

http://www.teamviewer.com/pt/download/index.aspx

id 867 018 631

pw 3904

Valeu

Agradeçido

Adilson