人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

ExcelVBAについて質問です。

[取込]ボタンを押下すると自動で下記動作を実行する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)の列幅は変えないようにしたい。(重要)

ご教示頂けますと大変助かります。
以上 宜しくお願い致します。


●質問者: hananeko_0
●カテゴリ:コンピュータ
✍キーワード:00 28 Excel VBA ウィザード
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●100ポイント ベストアンサー

こんな感じでどうでしょうか。

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
◎質問者からの返答

完璧な動作でした!

大変助かりました。ありがとうございました!

皆、感動しております。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ