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