title image


Smiley Re: Auswahl eines Pfads durch VBA
Dann versuch´s mal hiermit:





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



Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long



Dim OFName As OPENFILENAME



Dim Pfad As String



Private Const Blatt = "Overview"



Private Sub CommandButton1_Click()

Dataexchange_a

End Sub



Private Function ShowOpen() As String

'Set the structure size

OFName.lStructSize = Len(OFName)

'Set the filet

OFName.lpstrFilter = "Excel (*.xls)" + Chr$(0) + "*.xls" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)

'Create a buffer

OFName.lpstrFile = Space$(254)

'Set the maximum number of chars

OFName.nMaxFile = 255

'Create a buffer

OFName.lpstrFileTitle = Space$(254)

'Set the maximum number of chars

OFName.nMaxFileTitle = 255

'Set the initial directory

OFName.lpstrInitialDir = "C:\"

'Set the dialog title

OFName.lpstrTitle = "Datei öffnen"

'no extra flags

OFName.flags = 0



'Show the 'Open File'-dialog

If GetOpenFileName(OFName) Then

ShowOpen = Trim$(OFName.lpstrFile)

Else

ShowOpen = ""

End If

End Function



Sub Dataexchange_a()

Dim e_Test_name As String



Pfad = ShowOpen



If Pfad = "" Then

Exit Sub

End If



Dim xlWkb As Object

Set xlWkb = GetObject(Pfad)

e_Test_name = xlWkb.Sheets(Blatt).Cells(2, 2).Value

xlWkb.Parent.Quit

Set xlWkb = Nothing



Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

With Selection.Find

.Text = "Titem_name"

.Replacement.Text = e_Test_name

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

End With

Selection.Find.Execute Replace:=wdReplaceAll

End Sub



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: