いつもお世話様です。
vbaを始めたばっかりで、色々な情報をもらったのですが、
まだ理解に苦しんでいるところがあります。
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Sub PrintPDF(ByVal FileName As String, _
Optional ByVal Copies As Long = 1)
Dim dtLimit As Date
Dim lngChannel As Long
Dim I As Long
Dim blnAlerts As Boolean
CreateObject("Wscript.Shell").Run "AcroRd32.exe", 7
dtLimit = Now() + TimeSerial(0, 0, 10) ' 起動待ちの制限時間
With Application
blnAlerts = .DisplayAlerts 'DisplayAlertsを元に戻す為に初期値を記憶
.DisplayAlerts = False
End With
On Error GoTo Err_Handler
lngChannel = DDEInitiate("Acroview", "Control")
On Error GoTo 0
Application.DisplayAlerts = blnAlerts
For I = 1 To Copies
DDEExecute lngChannel, _
"[FilePrintSilent(""" & FileName & """)]"
Next
DDEExecute lngChannel, "[AppExit]"
DDETerminate lngChannel
Exit Sub
Err_Handler:
If Now() < dtLimit Then
Sleep 200
Resume
End If
Application.DisplayAlerts = blnAlerts
Err.Raise Err.Number, , "Adobe Readerとの通信を開始できません"
End Sub
Dim searchNo As Variant
Dim searchCount As Integer
Dim Localpath As Variant
Dim MyFile As String
Dim strFindRange As String
Localpath = ThisWorkbook.Path
Do
searchNo = _
StrConv(InputBox("図番を入力してください"), vbNarrow + vbUpperCase) 'Strconv=大文字・半角
If searchNo = "EXIT" Then Exit Sub
Do
searchCount = _
WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)
Select Case searchCount ←(2)
Case 0
MsgBox "正しい番号を入力して下さい"
Exit Do '外側のループに移動
Case 1
strFindRange = _
ActiveSheet.Range("A:A"). _
Find(what:=searchNo, Lookat:=xlWhole).Address ←(4)
Case Else
MsgBox "同じ番号が複数登録されています"
Exit Do
End Select
MyFile = Localpath & "\" & searchNo & Range(strFindRange).Offset(0, 1) & ".pdf"
If Dir(MyFile) = "" Then
MsgBox MyFile & " が見つかりません" & vbCrLf _
& "実際にファイルが有るか確認して下さい"
Exit Do
End If
If MsgBox(Range(strFindRange).Offset(0, 1) _
& " を印刷しますか", vbOKCancel) = vbCancel Then
Exit Do
End If
PrintPDF (MyFile)
Exit Do
Loop
Loop
End Sub
(1)ここの部分で、空白かキャンセルボタンをしたら
StrConv(InputBox("図番を入力してください"), vbNarrow + vbUpperCase)に戻りたいのですが、この場合どこにexit do を入れたいか分かりません。
(2)データが入っているフォルダ内に複数あるならそれを分岐にする方法ってありませんか？
(3)ここのRange(strFindRange).Offset(0, 1) は必要があるのでしょうか？
(4)Find(what:=searchNo, Lookat:=xlWhole).Address 部分の意味がわからないのですが教えてください。
ご指導よろしくお願いします
現在EXCEL VBAである行の値が変わったときにその列の塗りつぶしの
色を変えるといった処理を作成しております。
そこで、複数選択して値を変えた場合の処理が変数の型が一致しません
的なエラーが表示されてしまいます。
どのように修正したらうまくいくでしょうか？
教えてください。
ソースは下記の通りとなります。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 13 Then Exit Sub
Application.EnableEvents = False
MsgBox (Target.Rows.Count)
Dim rngSelectRng As Range
For Each rngSelectRng In Target
If rngSelectRng.Value = "" Then rngSelectRng.Value = " "
'ステータス欄の入力の判断
'Select Case Target.Rows.Value
MsgBox (Target.Row)
Select Case rngSelectRng.Value
Case "あああ"
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 24
Case "いいい"
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 35
Case "ううう"
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 38
Case "えええ"
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 36
Case "おおお"
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 16
Case Else
Worksheets("表１").Rows(Target.Row).Interior.ColorIndex = 2
End Select
Next
Application.EnableEvents = True
End Sub
教えてください。
指定した範囲から先頭がhのセルについて
色を付けていますが、範囲を固定ではなく
マウスで都度選択させたいのですが
どう直せば良いのでしょうか。
ActiveCell にすると最初のひとつしか変わりません。
Sub TEST()
Dim rg As Range
For Each rg In Range("D7", "D14")
If Left(rg.Value, 1) <> "h" Then
rg.Interior.ColorIndex = 23
rg.Offset(, 1).Interior.ColorIndex = 24
End If
Next rg
End Sub
いつもお世話様です。
vbaを始めたばっかりで、色々な情報をもらったのですが、
まだ理解に苦しんでいるところがあります。
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Sub PrintPDF(ByVal FileName As String, _
Optional ByVal Copies As Long = 1)
Dim dtLimit As Date
Dim lngChannel As Long
Dim I As Long
Dim blnAlerts As Boolean
CreateObject("Wscript.Shell").Run "AcroRd32.exe", 7
dtLimit = Now() + TimeSerial(0, 0, 10) ' 起動待ちの制限時間
With Application
blnAlerts = .DisplayAlerts 'DisplayAlertsを元に戻す為に初期値を記憶
.DisplayAlerts = False
End With
On Error GoTo Err_Handler
lngChannel = DDEInitiate("Acroview", "Control")
On Error GoTo 0
Application.DisplayAlerts = blnAlerts
For I = 1 To Copies
DDEExecute lngChannel, _
"[FilePrintSilent(""" & FileName & """)]"
Next
DDEExecute lngChannel, "[AppExit]"
DDETerminate lngChannel
Exit Sub
Err_Handler:
If Now() < dtLimit Then
Sleep 200
Resume
End If
Application.DisplayAlerts = blnAlerts
Err.Raise Err.Number, , "Adobe Readerとの通信を開始できません"
End Sub
Dim searchNo As Variant
Dim searchCount As Integer
Dim Localpath As Variant
Dim MyFile As String
Dim strFindRange As String
Localpath = ThisWorkbook.Path
Do
searchNo = _
StrConv(InputBox("図番を入力してください"), vbNarrow + vbUpperCase) 'Strconv=大文字・半角
If searchNo = "EXIT" Then Exit Sub
Do
searchCount = _
WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), searchNo)
Select Case searchCount ←(2)
Case 0
MsgBox "正しい番号を入力して下さい"
Exit Do '外側のループに移動
Case 1
strFindRange = _
ActiveSheet.Range("A:A"). _
Find(what:=searchNo, Lookat:=xlWhole).Address ←(4)
Case Else
MsgBox "同じ番号が複数登録されています"
Exit Do
End Select
MyFile = Localpath & "\" & searchNo & Range(strFindRange).Offset(0, 1) & ".pdf"
If Dir(MyFile) = "" Then
MsgBox MyFile & " が見つかりません" & vbCrLf _
& "実際にファイルが有るか確認して下さい"
Exit Do
End If
If MsgBox(Range(strFindRange).Offset(0, 1) _
& " を印刷しますか", vbOKCancel) = vbCancel Then
Exit Do
End If
PrintPDF (MyFile)
Exit Do
Loop
Loop
End Sub
(1)ここの部分で、空白かキャンセルボタンをしたら
StrConv(InputBox("図番を入力してください"), vbNarrow + vbUpperCase)に戻りたいのですが、この場合どこにexit do を入れたいか分かりません。
(2)データが入っているフォルダ内に複数あるならそれを分岐にする方法ってありませんか？
(3)ここのRange(strFindRange).Offset(0, 1) は必要があるのでしょうか？
(4)Find(what:=searchNo, Lookat:=xlWhole).Address 部分の意味がわからないのですが教えてください。
ご指導よろしくお願いします
