Barra de Menu
Publicado por Esteban (20 intervenciones) el 01/03/2007 00:11:41
Buen Dia
Tengo el siguiente problema haber si me pueden ayudar, en mi computadora existe una base de datos, a la cual se conectan varios usuarios, ahora me pidieron crear otra pero tengo estos problemas:
1.-al abrir el formulario sigue con los mismos usuarios de la otra base de datos sera que se pueden configurar
2.-Tendria que halar una barra de herramientas al abrir la base de datos pero no la hala digamos que es el usuario [administracion] y tengo la barra CGMMenu al abrir la base tendria que mostrarse esa barra y no se si tenga que realizar alguna relacion entre estos dos, yo copie el diseño de las barras de la otra base de datos la que ya esta terminada y en esa si hala las barras
por lo que me di cuenta habia un macro, y un modulo no se si esto tenga alguna relacion con la barra pero yo lo copie y ni asi me sale la barra de menu, este es el modulo:
Option Compare Database
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Function Inicio()
Application.SetOption "Built-In Toolbars Available", False
Application.SetOption "Can Customize Toolbars", False
End Function
Public Function ValidaString(ByVal strValue As String) As String
strValue = IIf(IsNull(strValue), "", strValue)
strValue = Replace(strValue, "'", "''")
ValidaString = strValue
End Function
Function SetOptions()
''''View Tab
''' Application.SetOption "Show Status Bar", 0
''' Application.SetOption "Show Startup Dialog Box", 0
''' Application.SetOption "Show Hidden Objects", 0
''' Application.SetOption "Show System Objects", 0
''' Application.SetOption "Show Macro Names Column", -1
''' Application.SetOption "Show Conditions Column", -1
'''
''''General Tab
''' Application.SetOption "Left Margin", "1 cm"
''' Application.SetOption "Right Margin", "1 cm"
''' Application.SetOption "Top Margin", "2 cm"
''' Application.SetOption "Bottom Margin", "2 cm"
'''
''''Edit/Find Tab
''' Application.SetOption "Default Find/Replace Behavior", 0
''' Application.SetOption "Confirm Record Changes", -1
''' Application.SetOption "Confirm Document Deletions", -1
''' Application.SetOption "Confirm Action Queries", -1
''' Application.SetOption "Show Values in Indexed", -1
''' Application.SetOption "Show Values in Non-indexed", -1
''' Application.SetOption "Show Values In Remote", 0
''' Application.SetOption "Show Values Limit", 1000
'''
''''Keyboard Tab
''' Application.SetOption "Move After Enter", 1
''' Application.SetOption "Arrow Key Behavior", 1
''' Application.SetOption "Behavior Entering Field", 0
''' Application.SetOption "Cursor Stops at First/Last Field", 0
'''
''''Tables/Queries Tab
''' Application.SetOption "Default Text Field Size", 50
''' Application.SetOption "Default Number Field Size", 4
''' Application.SetOption "Default Field Type", 0
''' Application.SetOption "AutoIndex on Import/Create", ""
''' Application.SetOption "Show Table Names", -1
''' Application.SetOption "Output All Fields", 0
''' Application.SetOption "Enable AutoJoin", -1
''' Application.SetOption "Run Permissions", 1
'''
''''Forms/Reports Tab
''' Application.SetOption "Selection Behavior", 0
''' Application.SetOption "Form Template", "Normal"
''' Application.SetOption "Report Template", "Normal"
''' Application.SetOption "Always Use Event Procedures", 0
'''
''''Advanced Tab
''' Application.SetOption "Default Record Locking", 0
''' Application.SetOption "Default Open Mode for Databases", 0
''' Application.SetOption "Ignore DDE Requests", 0
''' Application.SetOption "Enable DDE Refresh", -1
''' Application.SetOption "OLE/DDE Timeout (Sec)", 30
''' Application.SetOption "Number of Update Retries", 5
''' Application.SetOption "ODBC Refresh Interval (Sec)", 60
''' Application.SetOption "Refresh Interval (Sec)", 10
''' Application.SetOption "Update Retry Interval (Msec)", 250
''' Application.SetOption "Command-Line Arguments", ""
'''' Application.SetOption "Project Name", "YourProjectName"
''' Application.SetOption "Error Trapping", 1
'''' ChangeProperty "AppTitle", dbText, "YourTitle"
''' Application.RefreshTitleBar
''''' ChangeProperty "StartupShowDBWindow", dbBoolean, False
''''' ChangeProperty "StartupShowStatusBar", dbBoolean, True
''''' ChangeProperty "AllowBuiltinToolbars", dbBoolean, True
''''' ChangeProperty "AllowFullMenus", dbBoolean, True
''''' ChangeProperty "AllowShortcutMenus", dbBoolean, False
''''' ChangeProperty "AllowToolbarChanges", dbBoolean, False
''''' 'ChangeProperty "AllowBreakIntoCode", dbBoolean, False
''''' ChangeProperty "AllowSpecialKeys", dbBoolean, False
''''' 'ChangeProperty "AllowBypassKey", dbBoolean, True
End Function
Function InGroup(pUser As String, pGroup As String) As Boolean
Dim S As String
On Error Resume Next
S = DBEngine(0).Users(pUser).Groups(pGroup).Name
InGroup = (Err.Number = 0)
End Function
Function LaunchCD(strform As Form) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = strform.Hwnd
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
"JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "A file was not selected!", vbInformation, _
"Select a file using the Common Dialog DLL"
Else
LaunchCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlImageControl
If IsNull(strImagePath) Then
.Visible = False
strResult = "Nombre de imagen no especificado."
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Visible = True
.Picture = strImagePath
strResult = "Image found and displayed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
Tengo el siguiente problema haber si me pueden ayudar, en mi computadora existe una base de datos, a la cual se conectan varios usuarios, ahora me pidieron crear otra pero tengo estos problemas:
1.-al abrir el formulario sigue con los mismos usuarios de la otra base de datos sera que se pueden configurar
2.-Tendria que halar una barra de herramientas al abrir la base de datos pero no la hala digamos que es el usuario [administracion] y tengo la barra CGMMenu al abrir la base tendria que mostrarse esa barra y no se si tenga que realizar alguna relacion entre estos dos, yo copie el diseño de las barras de la otra base de datos la que ya esta terminada y en esa si hala las barras
por lo que me di cuenta habia un macro, y un modulo no se si esto tenga alguna relacion con la barra pero yo lo copie y ni asi me sale la barra de menu, este es el modulo:
Option Compare Database
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Function Inicio()
Application.SetOption "Built-In Toolbars Available", False
Application.SetOption "Can Customize Toolbars", False
End Function
Public Function ValidaString(ByVal strValue As String) As String
strValue = IIf(IsNull(strValue), "", strValue)
strValue = Replace(strValue, "'", "''")
ValidaString = strValue
End Function
Function SetOptions()
''''View Tab
''' Application.SetOption "Show Status Bar", 0
''' Application.SetOption "Show Startup Dialog Box", 0
''' Application.SetOption "Show Hidden Objects", 0
''' Application.SetOption "Show System Objects", 0
''' Application.SetOption "Show Macro Names Column", -1
''' Application.SetOption "Show Conditions Column", -1
'''
''''General Tab
''' Application.SetOption "Left Margin", "1 cm"
''' Application.SetOption "Right Margin", "1 cm"
''' Application.SetOption "Top Margin", "2 cm"
''' Application.SetOption "Bottom Margin", "2 cm"
'''
''''Edit/Find Tab
''' Application.SetOption "Default Find/Replace Behavior", 0
''' Application.SetOption "Confirm Record Changes", -1
''' Application.SetOption "Confirm Document Deletions", -1
''' Application.SetOption "Confirm Action Queries", -1
''' Application.SetOption "Show Values in Indexed", -1
''' Application.SetOption "Show Values in Non-indexed", -1
''' Application.SetOption "Show Values In Remote", 0
''' Application.SetOption "Show Values Limit", 1000
'''
''''Keyboard Tab
''' Application.SetOption "Move After Enter", 1
''' Application.SetOption "Arrow Key Behavior", 1
''' Application.SetOption "Behavior Entering Field", 0
''' Application.SetOption "Cursor Stops at First/Last Field", 0
'''
''''Tables/Queries Tab
''' Application.SetOption "Default Text Field Size", 50
''' Application.SetOption "Default Number Field Size", 4
''' Application.SetOption "Default Field Type", 0
''' Application.SetOption "AutoIndex on Import/Create", ""
''' Application.SetOption "Show Table Names", -1
''' Application.SetOption "Output All Fields", 0
''' Application.SetOption "Enable AutoJoin", -1
''' Application.SetOption "Run Permissions", 1
'''
''''Forms/Reports Tab
''' Application.SetOption "Selection Behavior", 0
''' Application.SetOption "Form Template", "Normal"
''' Application.SetOption "Report Template", "Normal"
''' Application.SetOption "Always Use Event Procedures", 0
'''
''''Advanced Tab
''' Application.SetOption "Default Record Locking", 0
''' Application.SetOption "Default Open Mode for Databases", 0
''' Application.SetOption "Ignore DDE Requests", 0
''' Application.SetOption "Enable DDE Refresh", -1
''' Application.SetOption "OLE/DDE Timeout (Sec)", 30
''' Application.SetOption "Number of Update Retries", 5
''' Application.SetOption "ODBC Refresh Interval (Sec)", 60
''' Application.SetOption "Refresh Interval (Sec)", 10
''' Application.SetOption "Update Retry Interval (Msec)", 250
''' Application.SetOption "Command-Line Arguments", ""
'''' Application.SetOption "Project Name", "YourProjectName"
''' Application.SetOption "Error Trapping", 1
'''' ChangeProperty "AppTitle", dbText, "YourTitle"
''' Application.RefreshTitleBar
''''' ChangeProperty "StartupShowDBWindow", dbBoolean, False
''''' ChangeProperty "StartupShowStatusBar", dbBoolean, True
''''' ChangeProperty "AllowBuiltinToolbars", dbBoolean, True
''''' ChangeProperty "AllowFullMenus", dbBoolean, True
''''' ChangeProperty "AllowShortcutMenus", dbBoolean, False
''''' ChangeProperty "AllowToolbarChanges", dbBoolean, False
''''' 'ChangeProperty "AllowBreakIntoCode", dbBoolean, False
''''' ChangeProperty "AllowSpecialKeys", dbBoolean, False
''''' 'ChangeProperty "AllowBypassKey", dbBoolean, True
End Function
Function InGroup(pUser As String, pGroup As String) As Boolean
Dim S As String
On Error Resume Next
S = DBEngine(0).Users(pUser).Groups(pGroup).Name
InGroup = (Err.Number = 0)
End Function
Function LaunchCD(strform As Form) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = strform.Hwnd
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
"JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "A file was not selected!", vbInformation, _
"Select a file using the Common Dialog DLL"
Else
LaunchCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlImageControl
If IsNull(strImagePath) Then
.Visible = False
strResult = "Nombre de imagen no especificado."
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Visible = True
.Picture = strImagePath
strResult = "Image found and displayed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
Valora esta pregunta


0