フォルダを選んで拡張子をxlsからxlsxに変換

最近の書き込み件数：今日 0件、昨日 0件
未読分：3件

Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応

近田伸矢, 植木悠二, 上田寛

IEのデータ収集＆自動操作のプログラミング本はこの1冊だけ！IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。

Message#3 2014年12月16日(火)11時31分
From: acos

返事削除変更

相当「あく」の強いプログラムをコピペしましたね。
すこし「あく」を薄めてあります。

Sub ColumAutofit()
Dim InputDirectory As String, FileName As String
Dim myWorkbook As Workbook

If _
MsgBox(Prompt:="列幅調整対象のxlsx形式ファイルが格納されたフォルダを入力してください。", _
Buttons:=vbOKCancel + vbInformation, Title:="入力ディレクトリ指定") = vbCancel Then
Exit Sub
End If

With Application
With .FileDialog(msoFileDialogFolderPicker)
If .Show = True Then InputDirectory = .SelectedItems(1)
If InputDirectory = "" Then Exit Sub
End With
.DisplayAlerts = False
.ScreenUpdating = False
End With
FileName = Dir(InputDirectory & "\*.xlsx")
Do While FileName <> ""
With Workbooks.Open(InputDirectory & "\" & FileName)
For Each sh In .Worksheets
sh.UsedRange.EntireColumn.AutoFit
Next sh
.Close SaveChanges:=True
End With
FileName = Dir()
Loop
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
MsgBox Prompt:="終了しました。", Buttons:=vbInformation, Title:="終了"
End Sub

Message#2 2014年12月16日(火)07時26分
From: VBAマスター

返事削除変更

例えば、アクティブシートのA～D列を自動調整するのであれば、

Columns("A:D").EntireColumn.AutoFit

とします。ワークシートを指定する場合は、

Worksheets("シート名").Columns("A:D").EntireColumn.AutoFit

としてください。
この辺りは、マクロの記録で試してみれば分かることです。

尚、ブックの全てのシートについて行なう、ということであれば、以下のようにしてください。

For Each ws In myWorkbook
ws.Columns("A:D").EntireColumn.AutoFit
Next

ワークブックの中のワークシートオブジェクトを、変数wsに順次取り出して、ループの中で使用しています。この場合、ワークブックは、ご質問に提示されている変数にしていますので、違っている場合は別なものに変更してください。

Message#1 2014年12月16日(火)07時25分
From: 拡張子変換

返事削除変更

フォルダを選んで拡張子をxlsからxlsxに変換するVBAを組みました。（他の方のをコピペしました）
変換するとともにファイルの列幅も自動調整したいのですが、
どのうように修正すれば良いのでしょうか？

フォルダ内には
50～100個ほどエクセルファイルがあり（発注データの為、日々変動）、
毎日１つ１つ開いてダブルクリックして列幅を調整しxlsxに変換して保存しなおしております・・
xlsxに変換するのは下記のVBAでできたので、同時に列幅も自動調整したいです。

VBA初心者の為コードを教えていただけると助かります。

Option Explicit

Sub FromXlsToXlsx()
Dim InputDirectory As String, OutputDirectory As String, FileName As String
If MsgBox( _
Prompt:="xlsx形式に変換するxlsファイルが格納されたフォルダを入力してください。", _
Buttons:=vbOKCancel vbInformation, _
Title:="入力ディレクトリ指定") _
= vbCancel Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then InputDirectory = .SelectedItems(1)
End With
If InputDirectory = "" Then Exit Sub
If MsgBox( _
Prompt:="変換されたxlsxファイルを格納するフォルダを入力してください。", _
Buttons:=vbOKCancel vbInformation, _
Title:="出力ディレクトリ指定") _
= vbCancel Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then OutputDirectory = .SelectedItems(1)
End With
If OutputDirectory = "" Then Exit Sub
Dim myExcel As New Excel.Application
myExcel.Visible = False
myExcel.DisplayAlerts = False
Dim myWorkbook As Workbook
FileName = Dir(InputDirectory & "\*.xls")
Do While FileName <> ""
Set myWorkbook = myExcel.Workbooks.Add(InputDirectory & "\" & FileName)
Call myWorkbook.SaveAs( _
FileName:=OutputDirectory & "\" & Mid(FileName, 1, InStrRev(FileName, ".")) & "xlsx", _
FileFormat:=xlWorkbookDefault) 'xlsx形式は"xlWorkbookDefault", xlsm形式は"xlOpenXMLWorkbookMacroEnabled", xlsb形式は"xlExcel12"
Call myWorkbook.Close(SaveChanges:=False)
FileName = Dir()
Loop
Set myWorkbook = Nothing
myExcel.Quit
Call MsgBox( _
Prompt:="終了しました。", _
Buttons:=vbInformation, _
Title:="終了")
End Sub