フォルダを選んで拡張子をxlsからxlsxに変換 削除
| 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 |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。
