|
Sub 違うやつ()
Workbooks("明細.xls").Activate
Workbooks("明細.xls").Worksheets(2).Select
Dim myhyperlink As Hyperlink
For Each myhyperlink In ActiveSheet.Hyperlinks
myhyperlink.Delete
Next
Do
名前 = InputBox("図面の必要な材料コードを入力してください 例:***-****", vbRetryCancel)
Loop Until 名前 <> ""
ActiveSheet.Range("C1:C600").Find(what:=名前).Select
Do
'新しいファイル名の作成
bb = Selection.Offset(0, "-1").Value
Select Case bb
Case Is = "A"
番号 = "00" & bb
Case Is = "B"
番号 = "00" & bb
Case Is = "C"
番号 = "00" & bb
Case Is = "D"
番号 = "00" & bb
Case Is = "E"
番号 = "00" & bb
Case Is = "F"
番号 = "00" & bb
Case Is = "G"
番号 = "00" & bb
Case Is >= 10
番号 = "0" & bb
Case Is < 10
番号 = "00" & bb
End Select
材料名 = Selection.Offset(0, 1).Value
サイズ1 = Selection.Offset(0, 2).Value
サイズ2 = Selection.Offset(0, 3).Value
サイズ3 = Selection.Offset(0, 4).Value
サイズ = サイズ1 & サイズ2 & サイズ3
長さ1 = Selection.Offset(0, 5).Value
長さ2 = Selection.Offset(0, 6).Value
長さ3 = Selection.Offset(0, 7).Value
長さ = 長さ1 & 長さ2 & 長さ3
数量 = Selection.Offset(0, 8).Value
'フォルダの存在1
製番1 = Worksheets(1).Range("B3").Value
Dim 検索1 As String
検索1 = Dir("C:\Documents and Settings\mkn\デスクトップ\" & 製番1 & "部材明細表(ヘッド・テール)", Attributes:=vbDirectory)
'検索してフォルダがある場合
If 検索1 = 製番1 & ActiveSheet.Name Then
Dim 検索11 As String
検索11 = Dir("c:\加工図\" & Selection.Value & ".dwg", Attributes:=vbNormal)
'検索してファイルが指定の場所にある場合
If 検索11 = Selection.Value & ".dwg" Then
Dim ファイル変更1 As New FileSystemObject
ファイル変更1.CopyFile "c:\加工図\" & Selection.Value & ".dwg", _
"c:\documents and settings\mkn\デスクトップ\" & 製番1 & ActiveSheet.Name _
& "\" & 番号 & 材料名 & "×" & サイズ & "×" & 長さ & "-" & 数量 & "s.dwg"
'検索してファイルが指定の場所にない場合
ElseIf 検索11 <> Selection.Value & ".dwg" Then
Selection.Interior.Color = RGB(255, 255, 0)
End If
'検索してフォルダがない場合
ElseIf 検索1 <> 製番1 & ActiveSheet.Name Then
Call フォルダの作成1
Dim ファイル変更2 As New FileSystemObject
ファイル変更2.CopyFile "c:\加工図\" & Selection.Value & ".dwg", _
"c:\documents and settings\mkn\デスクトップ\" & 製番1 & ActiveSheet.Name _
& "\" & 番号 & 材料名 & "×" & サイズ & "×" & 長さ & "-" & 数量 & "s.dwg"
End If
Selection.Offset(1, 0).Select
Loop Until Selection.Value = ""
End Sub
ファイルの検索をかけたのですが、
認識されません・・・・・
どなたか、メールでもいいので教えてください!!
|
|