「ExcelVBA」の編集履歴（バックアップ）一覧に戻る

ExcelVBA - (2006/05/14 (日) 00:13:15) のソース

<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>