Rangeで取得したシート名を作成し、対象ディレクトリの画像を張り付ける
Sub createSheet()
Dim i As Integer
Dim ArrSheetName As Variant
ArrSheetName = Range("B2:B43") ''変数定義変更する
ArrImgName = Range("C2:C43") ''変数定義変更する
ImgPath = "[filename]"
For i = LBound(ArrSheetName) To UBound(ArrSheetName)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ArrSheetName(i, 1)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="リスト!A2", TextToDisplay:="<<一覧へ戻る"
ActiveSheet.Range("A2").Select
ActiveSheet.Pictures.Insert(ImgPath + ArrImgName(i, 1)).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 0.6
Next
ActiveWorkbook.Worksheets("リスト").Activate
End Sub
Rangeで取得したシート名を全て削除する
Sub deleteSheet()
Dim i As Integer
Dim ArrSheetName As Variant
ArrSheetName = Range("B2:B43") ''変数定義変更する
ret = MsgBox("リストシート以外を全て破棄します。", vbOKCancel)
If ret = 1 Then
For i = LBound(ArrSheetName) To UBound(ArrSheetName)
Application.DisplayAlerts = False
Sheets(ArrSheetName(i, 1)).Delete
Application.DisplayAlerts = True
Next
End If
End Sub
最終更新:2009年08月31日 18:49