[取込]ボタンを押下すると自動で下記動作を実行するVBAについて
教えて頂けますと大変助かります。
[取込]ボタン(オートシェイプ四角)←マクロの登録
1)セル(固定 例:C19)を選択
2)データ>外部データの取込み>データの取込みを選択
3)[データファイルの選択]画面にて対象ファイル(tsv)を選択
※tsvファイルはタブ区切り
4)[テキストファイルウィザード 1/3] デフォルトのまま[次へ]
※データ形式は、カンマやタブなどの区切り・・
5)[テキストファイルウィザード 2/3] デフォルトのまま[次へ]
※区切り文字はタブ、文字列の引用符は"
6)[テキストファイルウィザード 2/3] ★データ形式を変更
11列目→文字列
12列目→文字列
13列目→文字列
※日付を[2010/01/28 17:00:00]←このままで取込みたい為
[完了]を押下
7)取込み後、自動保存
★他の動作
・セル(固定 例:C2)に取込んだファイル名を表示
・上記で取込みをすると、自動で列を調整するため
取込む前の状態(Excel)の列幅は変えないようにしたい。(重要)
ご教示頂けますと大変助かります。
以上 宜しくお願い致します。
こんな感じでどうでしょうか。
Sub 四角形1_Click() Const strRange As String = "C9" '固定セルの指定 Const strTitle As String = "C2" 'ファイル名セルの指定 Dim vntFileName As Variant vntFileName = Application.GetOpenFilename( _ FileFilter:="tsvファイル(*.tsv),*.tsv" _ , FilterIndex:=1 _ , Title:="tsvファイルを選択してください" _ , MultiSelect:=False) If vntFileName = False Then Exit Sub ActiveSheet.Range(strRange).Select With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & vntFileName, Destination:=Range(strRange)) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 932 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With ActiveSheet.Range(strTitle).Value = Mid(vntFileName, InStrRev(vntFileName, "\") + 1) ThisWorkbook.Save End Sub
マクロの自動記録で14列のデータで試したので付いたものです。
無ければ自動的に1(標準)になるので。