※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

「ExcelVBA」の編集履歴(バックアップ)一覧はこちら

ExcelVBA」の最新版変更点

追加された行は青色になります。

削除された行は赤色になります。

 
 <pre>
 サンプルソース<br>
 </pre>
 <pre>
 ※指定したシートの指定した範囲から単一データの値を取得する関数<br>
 -[[http://kudoken.com]]<br>
 <br>
 <br>
 <br>
 <br>
 </pre>
 <hr>
 <div align="left">
 <pre>
 Function getConf(strKey As String)AsStringDim rngData As Range<br>
 Dim i As Integer<br>
 <br>
 Set rngData = ThisWorkbook.Sheets("config").Range("rng_conf").CurrentRegion<br>
 <br>
 For i = 1 To rngData.Rows.Count<br>
 <br>
   If rngData.Cells(i, 1).Value = strKey Then<br>
 <br>
    getConf = rngData.Cells(i, 2).Value  <br>
    Exit For<br>
 <br>
   End If <br>
 Next i<br>
 <br>
+End Function
+</pre>
+<pre>
+Sub test()
+</pre>
+<pre>
+  Dim strCurPath As String<br>
+  Dim strTmpName As String<br>
+  Dim strActTmpName As String<br>
+  Dim strMakeFileName As String<br>
+  Dim strSaveDirName As String
+</pre>
+<pre>
+  Dim wbkTmp As Workbook<br>
+  Dim wbkMake As Workbook
+</pre>
+<pre>
+  Dim fName As String
+</pre>
+<pre>
+  'カレントディレクトリ指定<br>
+  strCurPath = ThisWorkbook.Path
+</pre>
+<pre>
+  '保存先フォルダ取得<br>
+  strSaveDirName = fncGetDirName()
+</pre>
+<pre>
+<br>
+  If strSaveDirName &lt;&gt; "" Then
+</pre>
+<pre>
+   strTmpName = strCurPath &amp; "\free.xlt"<br>
+   strMakeFileName = strSaveDirName &amp; "\make.xls"<br>
+ <br>
+   'テンプレートファイルを開く<br>
+   Workbooks.Open Filename:=strTmpName<br>
+   'テンプレートオブジェクトセット<br>
+   Set wbkTmp = ActiveWorkbook<br>
+   '新規作成ファイルのセット<br>
+   Set wbkMake = Workbooks.Add<br>
+  <br>
+   wbkTmp.Sheets(1).Copy After:=wbkMake.Sheets(3)<br>
+   ActiveSheet.Name = 1<br>
+  <br>
+   Application.DisplayAlerts = False<br>
+   'テンプレートファイルを閉じる<br>
+   wbkTmp.Close<br>
+   '不要なシートを削る<br>
+   wbkMake.Sheets(1).Delete<br>
+   wbkMake.Sheets(1).Delete<br>
+   wbkMake.Sheets(1).Delete<br>
+   '作成ファイルの保存<br>
+   wbkMake.SaveAs Filename:=strMakeFileName<br>
+  <br>
+   Application.DisplayAlerts = True
+</pre>
+<pre>
+  End If
+</pre>
+<pre>
+End Sub<br>
+</pre>
+<pre>
+'************************************************<br>
+' 概要:フォルダ名を取得する<br>
+'************************************************<br>
+Function fncGetDirName() As String
+</pre>
+<pre>
+  With Application.FileDialog(msoFileDialogFolderPicker)<br>
+    If .Show = True Then<br>
+      fncGetDirName = .SelectedItems(1)<br>
+    End If<br>
+  End With<br>
 End Function<br>
+<br>
 </pre></div>
 <hr>