「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<br>
</pre></div>
<hr>
<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 <> "" Then
</pre>
<pre>
strTmpName = strCurPath & "\free.xlt"<br>
strMakeFileName = strSaveDirName & "\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>