Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Otwarcie dokumentu jako dodatkowy arkusz w Excelu
pawjan69




Typ: neutral
Postów: 4
Zarejestrowany: Dec 2004
Otwarcie dokumentu jako dodatkowy arkusz w Excelu

Otwieram mój plik exela są tam np 3 arkusze.
Później za pomoca funkcji import importuje plik textowy.
Tylko, że ten importowany plik otwiera mi sie jako nowy dokument excel a chciałbym aby on sie zaimportował jako czwarty arkusz do mojego już otwartego dokumentu. Idelanie by było jaby jeszcze ten arkusz zawsze przyjmował taką samą nazwe.
Pozdrawiam


_____________________________________________
POZDRAWIAM 
PawJan

29-01-2005 14:15
Pokaż profil pawjan69  Wyślij email do pawjan69   
Piotr T




Typ: neutral
Postów: 176
Zarejestrowany: May 2004

Nagraj macro i po sprawie


_____________________________________________
Visual Basic.NET - Mercedes dla programistów

29-01-2005 15:18
Pokaż profil Piotr T  Wyślij email do Piotr T   Odwiedź stronę Piotr T  
karolinavb




Typ: neutral
Postów: 468
Zarejestrowany: Jan 2003

Pawle ?
Jeśli sobie nie poradziłeś to istotna jest zaznaczona część, reszta oczywiście zależy od Twojej specyfikacji importu, nazwa arkusza oczywiście może być parametrem tej procedury:

Sub ImportDoNowegoArkusza()
Dim oArk As Worksheet
    Set oArk = ThisWorkbook.Worksheets.Add
    oArk.Name = "Karolina"
    With oArk
.QueryTables.Add(Connection:= _
        "TEXT;D:\Documents and Settings\Karol\Moje dokumenty\mojskoroszyt.csv", _
        Destination:=Range("A1" ))
        .Name = "mojskoroszyt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

P.S. Maciek raczej jest potrzebny tutaj ja nie jestem specjalistką w tej dziedzinie...


_____________________________________________
Karolina

30-01-2005 02:09
Pokaż profil karolinavb  Wyślij email do karolinavb   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003

Masz dwa sposoby.
Pierwszy już znasz - to sposób Piotra.
Drugi, to sposób Karoliny.

Oba są dobre, tylko, że przy sposobie Piotra zawsze otrzymasz nowy skoroszyt
Aby sytuację naprawić musiałbyś arkusz z danymi z nowego skoroszytu wyeksportować do Twojego pliku.

ActiveSheet.Copy ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = "cos tam"

...ale...
I tu problem z przykładem Karoliny...
Jeśli chcesz, by Twój nowy arkusz zawsze nosił tę samą nazwę nie możesz wporst przypisać mu nowej nazwy, jeśli w Twoim zeszycie już będzie istniał taki arkusz. Możesz to sprawdzić w pętli:

Dim sh As Woksheet

For Each sh In ThisWorkbook.Worksheets
    if sh.Name = "cos tam" then ThisWorkbook.Worksheets("cos tam".Delete
Next sh

...lub...

Dim sh As Woksheet

On Error Resume Next
Set sh In ThisWorkbook.Worksheets("cos tam"
If not sh is Nothing then ThisWorkbook.Worksheets("cos tam".Delete


Dopiero po usunięciu arkusza o tej samej nazwie z Twojego skoroszytu bedziesz mógł zmienić mu nazwę na taką, jaką chcesz. No, chyba, że zmienisz nazwę istniejącego już arkusza na inną.

W razie problemów podeślij plik, a powiem, gdzie są błędy i jak się ich pozbyć.

[Post edytowany dnia 30-01-2005 22:40 przez losmac]


_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

30-01-2005 22:38
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
karolinavb




Typ: neutral
Postów: 468
Zarejestrowany: Jan 2003

No i trzeba dodać, że metoda Add ma jeszcze inne parametry:

expression.Add(Before, After, Count, Type)

expression  Required. An expression that returns one of the above objects.

Before  Optional Variant. An object that specifies the sheet before which the new sheet is added.

After  Optional Variant. An object that specifies the sheet after which the new sheet is added.

Count  Optional Variant. The number of sheets to be added. The default value is one.

Type  Optional Variant. Specifies the sheet type. Can be one of the following XlSheetType constants: xlWorksheet, xlChart, xlExcel4MacroSheet, or xlExcel4IntlMacroSheet. The default value is xlWorksheet

Zwłaszcza before czy after przydadzą się do określenia "lokalizacji" nowego arkusza.

Ale na tym forum jest wiecej przykładów wykorzystania tej metody podanych przez Maćka, zresztą...

[Post edytowany dnia 31-01-2005 08:27 przez karolinavb]


_____________________________________________
Karolina

31-01-2005 08:25
Pokaż profil karolinavb  Wyślij email do karolinavb   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003

Oto kod:

Option Explicit 'wymuś deklarowanie zmiennych

Sub OpenBocadFile()
Dim sFileName As String
Dim sh As Worksheet
Dim sh_exists As Boolean
Dim i As Integer, j As Integer


'przechwyć błędy
On Error GoTo Err_OpenBocadFile

' wskazuje i otwieram plik
sFileName = FileToOpen
If sFileName = "" Then
    Exit Sub
Else
    Workbooks.OpenText Filename:=sFileName, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlFixedWidth, OtherChar:="+", _
        FieldInfo:=Array(0, 1)
End If

'po otwarciu nowego skoroszytu z zaimportowanym plikiem

'przenoszę arkusz do mojego skoroszytu zestawienie materiałowe.xls
ActiveSheet.Move Before:=ThisWorkbook.Worksheets(2)
'ustawiam referencję na niego
Set sh = ActiveSheet

'sprawdź, czy istnije arkusz o nazwie "Materiały"
sh_exists = WorksheetExists()
If sh_exists Then
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Materiały".Delete
    Application.DisplayAlerts = True
End If

' zmieniem nazwe arkusza
sh.Name = "Materiały"

sh.Columns("A:A".Select
Selection.Sort Key1:=sh.Range("A1", Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'znajdź pierwszy pusty
j = 1
Do While sh.Range("A" & j) <> ""
    j = j + 1
Loop

'znajdź "RAZEM"
j = j - 1
i = 1
Do While Left(sh.Range("A" & i), 5) <> "RAZEM"
    i = i + 1
Loop

'usuń wszystkie RAZEM
sh.Range(i & ":" & j).Select
sh.Range(i & ":" & j).Delete
       
'zaznacz używany obszar
sh.UsedRange.Select
'to u mnie nie działa, mam Office 97 Pro
Selection.TextToColumns Destination:=Range("A1", DataType:=xlFixedWidth, _
    OtherChar:="+", FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(23, 1), Array(29, 1), _
    Array(37, 1), Array(52, 1)), DecimalSeparator:="." '
       
Exit_OpenBocadFile:
    On Error Resume Next
    Set sh = Nothing
    Exit Sub

Err_OpenBocadFile:
    MsgBox Err.Description, vbExclamation, "Błąd nr: " & Err.Number
    Err.Clear
    Resume Exit_OpenBocadFile
End Sub

'funkcja do pobierania nazwy pliku
Function FileToOpen() As String
Dim sTmp As String

'w razie błędów - przejdź do podprogramu obsługi błędów
On Err GoTo Err_FileToOpen

'wskaż plik
sTmp = Application.GetOpenFilename("Bocad Files (*.lis; *.txt),*.lis;*.txt"

'jeśli użytkownik nie nacisnął Anuluj
If sTmp <> CStr(False) Then FileToOpen = sTmp

Exit_FileToOpen:
    Exit Function
   
Err_FileToOpen:
    'jeśli użytkownik nie nacisnął Anuluj
    FileToOpen = ""
    Resume Exit_FileToOpen
End Function


'funkcja sprawdza, czy istnije arkusz o podanej nazwie
'domyślna nazwa to "Materiały"
Function WorksheetExists(Optional shName As String = "Materiały" As Boolean
Dim sh_tmp As Worksheet

WorksheetExists = False

'odłóż obsługę błędów
On Error Resume Next

'sprawdź, czy istnieje arkusz "Materiały" w kolekcji tego skoroszytu
Set sh_tmp = ThisWorkbook.Worksheets("Materiały"
'taki arkusz istnieje
If Not sh_tmp Is Nothing Then WorksheetExists = True

End Function



_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

01-02-2005 20:55
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
Wszystkich odpowiedzi: 5 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1