2012-03-28 10 views
1

グラフを作成してブックに2枚追加するマクロがあります。特定のフォルダからExcelファイルのデータをプルするシートを追加し、他の2枚より前のシートにExcelファイルを追加するにはどうすればよいですか?追加するには既存のシートの隣にあるシートにXLSファイルを追加する

Private Sub Workbook_Open() 

    Dim files(1 To 20) As String 
    Dim numOfFiles As Integer 
    Dim chartName As String 
    Dim FilePath As String 
    Dim strPath As String 
    Dim strFile As String 
    Dim strFile1 As String 
    Dim strChart As String 
    Dim i As Integer 
    Dim j As Integer 


    strPath = "C:\PortableRvR\report\" 
    strFile = Dir(strPath & "*.csv") 
    i = 1 
    Do While strFile <> "" 
     With ActiveWorkbook.Worksheets.Add 
      With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _ 
       Destination:=.Range("A1")) 
       .Parent.Name = Replace(strFile, ".csv", "") 
       .TextFileParseType = xlDelimited 
       .TextFileTextQualifier = xlTextQualifierDoubleQuote 
       .TextFileConsecutiveDelimiter = False 
       .TextFileTabDelimiter = False 
       .TextFileSemicolonDelimiter = False 
       .TextFileCommaDelimiter = True 
       .TextFileSpaceDelimiter = False 
       .TextFileColumnDataTypes = Array(1) 
       .TextFileTrailingMinusNumbers = True 
       .Refresh BackgroundQuery:=False 
       files(i) = .Parent.Name 
       i = i + 1 
      End With 
     End With 
     strFile = Dir 
    Loop 

    chartName = "Chart 8" 
    For j = 1 To numOfFiles 
     strFile = files(j) 
     Sheets(strFile).Select 
     Plot_y = Range("E1", Selection.End(xlDown)).Rows.Count 
     Plot_x = Range("D1", Selection.End(xlDown)).Rows.Count 

     Sheets("Uplink VS attenuation").Select 
     If j = 1 Then ActiveSheet.ChartObjects(chartName).Activate 

     With ActiveChart 

      .HasTitle = True 
      .ChartTitle.Characters.Text = "TxPower" 
      .Axes(xlCategory, xlPrimary).HasTitle = True 
      .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Attenuation(dB)" 
      .Axes(xlValue, xlPrimary).HasTitle = True 
      .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "TxPower(dBm)" 
      .Axes(xlCategory, xlPrimary).MinimumScale = 30 ' Constant value 

     End With 

     ActiveChart.SeriesCollection.NewSeries 
     ActiveChart.SeriesCollection(j).Name = strFile 
     ActiveChart.SeriesCollection(j).XValues = Sheets(strFile).Range("D1:D" & Plot_x) 
     ActiveChart.SeriesCollection(j).Values = Sheets(strFile).Range("E1:E" & Plot_y) 
     ActiveChart.SeriesCollection(j).MarkerStyle = -4142 
     ActiveChart.SeriesCollection(j).Smooth = False 
    Next j 

    ActiveSheet.ChartObjects(chartName).Activate 
    ActiveChart.Axes(xlValue).DisplayUnit = xlMillions 
    ActiveChart.Axes(xlValue).HasDisplayUnitLabel = False 
End Sub 
+2

あなたは何を試してみましたか?何もしなければ、Excel VBAの "F1"という魔法のボタンを押して 'Sheets.Add'の内容を確認したいかもしれません;) –

+0

Ok。あなたは上記のコードに直面している問題は何ですか? –

+0

私はこのコードを覚えています:)以前より早く動いていましたか? csvをインポートした後にグラフが生成されていました。あなたが望む唯一のものは 'Sheets(" Uplink VS attenuation ")の前にそのシートを動かすことです。 –

答えて

2

Sheets("Uplink VS attenuation")を持ってSample.txtをからBook2.xlsxにシート1を、言って、あなたはあなたのニーズに合わせて、それを修正してください。このサンプルコード

を使用することができます。

Sub Sample() 
    Dim wb As Workbook, wbTemp As Workbook 
    Dim ws As Worksheet, wsTemp As Worksheet 

    '~~> This is the workbook which has the "Uplink VS attenuation" sheet 
    Set wb = ThisWorkbook 
    Set ws = Sheets("Uplink VS attenuation") 

    '~~> Open the relevant text file. Change as applicable 
    Workbooks.OpenText Filename:="C:\Temp\Sample.txt", Origin:=437, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _ 
    Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _ 
    TrailingMinusNumbers:=True 

    Set wbTemp = ActiveWorkbook 
    Set wsTemp = wbTemp.Sheets(1) 

    '~~> Copy the relevant sheet before "Uplink VS attenuation" 
    wsTemp.Copy Before:=ws 

    '~~> Close text file without saving 
    wbTemp.Close savechanges:=False 

    '~~> Clean Up 
    Set wb = Nothing: Set wbTemp = Nothing 
    Set ws = Nothing: Set wsTemp = Nothing 
End Sub 

:私はすべてのエラー処理を行っていません。私はあなたがそれの世話をすることができます確信している:)

HTH

シド

+0

はい:)コード「Workbooks.OpenText .....」を適切に修正するだけです。 –

+0

あなたの質問に上記のコードを投稿してください。 –