hk43m
07-21-2008, 12:06 AM
Hi everybody,
this is the continuation of my first post (save specific cells).
I would like to load specific cells from a specific excel file which is chosen with a browse. (thank you Fumei)
My only problem is :
How give a name to the file the user has selected with the browse?
(the lines in red)
[vba] (excel 2003)
Option Explicit
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long
Private 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
Function BrowseForFile(sInitDir As String, _
Optional ByVal sFileFilters As String, _
Optional sTitle As String = "Open File", _
Optional lParentHwnd As Long) As String
Dim tFileBrowse As OpenFileName
Const clMaxLen As Long = 254
tFileBrowse.lStructSize = Len(tFileBrowse)
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", vbNullChar)
sFileFilters = Replace(sFileFilters, ";", vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
'Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If
'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & _
"All Files (*.*)" & vbNullChar & "*.*" _
& vbNullChar
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle
'No flags
tFileBrowse.flags = 0
'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
'Remove trailing null
BrowseForFile = Left$(BrowseForFile, _
Len(BrowseForFile) - 1)
End If
End If
End Function
Sub LoadTheCells()
Dim Name As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim Sheet1 As Worksheet
Set ws = ActiveSheet
ActiveSheet.Unprotect ("code")
Name = MsgBox BrowseForFile("C:\Documents and Settings\43448586\My Documents\Macro\FolderTest", "Excel File (*.xls);*.xls", _
"Open Workbook")
Set aWb = Workbooks.Open("Name")
Set Sheet1 = aWb.ActiveSheet
With Sheet1
.Range("B3:B13").Copy
Cellela.[B3].PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
Cellela.[D3].PasteSpecial Paste:=xlValues
End With
aWb.Close SaveChanges:=False
ws.Protect ("code")
End Sub
Thanks a lot :hi:
this is the continuation of my first post (save specific cells).
I would like to load specific cells from a specific excel file which is chosen with a browse. (thank you Fumei)
My only problem is :
How give a name to the file the user has selected with the browse?
(the lines in red)
[vba] (excel 2003)
Option Explicit
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long
Private 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
Function BrowseForFile(sInitDir As String, _
Optional ByVal sFileFilters As String, _
Optional sTitle As String = "Open File", _
Optional lParentHwnd As Long) As String
Dim tFileBrowse As OpenFileName
Const clMaxLen As Long = 254
tFileBrowse.lStructSize = Len(tFileBrowse)
'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", vbNullChar)
sFileFilters = Replace(sFileFilters, ";", vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
'Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If
'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & _
"All Files (*.*)" & vbNullChar & "*.*" _
& vbNullChar
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle
'No flags
tFileBrowse.flags = 0
'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
'Remove trailing null
BrowseForFile = Left$(BrowseForFile, _
Len(BrowseForFile) - 1)
End If
End If
End Function
Sub LoadTheCells()
Dim Name As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim Sheet1 As Worksheet
Set ws = ActiveSheet
ActiveSheet.Unprotect ("code")
Name = MsgBox BrowseForFile("C:\Documents and Settings\43448586\My Documents\Macro\FolderTest", "Excel File (*.xls);*.xls", _
"Open Workbook")
Set aWb = Workbooks.Open("Name")
Set Sheet1 = aWb.ActiveSheet
With Sheet1
.Range("B3:B13").Copy
Cellela.[B3].PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
Cellela.[D3].PasteSpecial Paste:=xlValues
End With
aWb.Close SaveChanges:=False
ws.Protect ("code")
End Sub
Thanks a lot :hi: