散布図の設定を線ありにし、かつ終点を矢印にしたいのですが、線はかけるものの、矢印の設定の時、
With Sheet1.ChartObjects("Chart").Chart.SeriesCollection(1)
.Border.LineStyle = xlContinuous '線の種類(連続線)
End With
With sheet1.ChartObjects("Chart").ShapeRange
.Line.EndArrowheadStyle = msoArrowheadOpen
End With
と設定すると、指定された値は境界を超えています。とでます。いくつかの方法でやりましたが、オブジェクトが対象ではないなど、エラーがどうしてもでてしまいます。どのように設定したら良いでしょうか？
sheet1（表-1）の入力文字「A,C,E」をsheet2へコピーする。
sheet2（表-3)のように[A,C,E」以外及びsheet1空白のセルはsheet2でも空白としたい。
その際、sheet2（表-2)に入力済みの記号「○、●、◎」はそのまま残したい。
下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。
どなたかコードがわかる方よろしくお願いします。
Sub シートコピー()
Dim r As Range
For Each r In Worksheets("Sheet1").Range("B1:D5")
If WorksheetFunction.CountIf(Range("A8:A10"), r.Value) Then
Sheets("sheet2").Range(r.Address).Value = r.Value
Else
Sheets("sheet2").Range(r.Address).Value = ""
End If
Next
End Sub
セルA11に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。
sheet1（表-1）の入力文字「A,C,F,H」をsheet2へコピーする。
sheet2（表-3)のように[A,C,F,H」以外及びsheet1空白のセルはsheet2でも空白としたい。
その際、sheet2（表-2)に入力済みの記号「○、●、◎」はそのまま残したい。
下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。
どなたかコードがわかる方よろしくお願いします。
Sub シートコピー()
Dim r As Range
For Each r In Worksheets("Sheet1").Range("B1:F10")
If WorksheetFunction.CountIf(Range("A14:A18"), r.Value) Then
Sheets("sheet2").Range(r.Address).Value = r.Value
Else
Sheets("sheet2").Range(r.Address).Value = ""
End If
Next
End Sub
セルA18に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。
sheet1（表-1）の入力文字「A,C,F,H」をsheet2へコピーする。
sheet2（表-3)のように[A,C,F,H」以外及びsheet1空白のセルはsheet2でも空白としたい。
その際、sheet2（表-2)に入力済みの記号「○、●、◎」はそのまま残したい。
下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。
どなたかコードがわかる方よろしくお願いします。
Sub シートコピー()
Dim r As Range
For Each r In Worksheets("Sheet1").Range("B1:F10")
If WorksheetFunction.CountIf(Range("A14:A18"), r.Value) Then
Sheets("sheet2").Range(r.Address).Value = r.Value
Else
Sheets("sheet2").Range(r.Address).Value = ""
End If
Next
End Sub
セルA18に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。
sheet1（表-1）の入力文字「A,C,F,H」をsheet2へコピーする。
sheet2（表-3)のように[A,C,F,H」以外及びsheet1空白のセルはsheet2でも空白としたい。
その際、sheet2（表-2)に入力済みの記号「○、●、◎」はそのまま残したい。
下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。
どなたかコードがわかる方よろしくお願いします。
Sub シートコピー()
Dim r As Range
For Each r In Worksheets("Sheet1").Range("B1:F10")
If WorksheetFunction.CountIf(Range("A14:A18"), r.Value) Then
Sheets("sheet2").Range(r.Address).Value = r.Value
Else
Sheets("sheet2").Range(r.Address).Value = ""
End If
Next
End Sub
セルA18に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。
Ｅｘｃｅｌのマクロについての質問です。
マクロについての質問です。
以下のようなマクロを作成しました。
このマクロを動作させているのはこのマクロを作成したファイル上です。
Sub Macro9()
Dim WBA As Workbook
Dim WBB As Workbook
Dim WSA As Worksheet
Dim WSB As Worksheet
Set WBA = Workbooks("Ａ")
Set WBB = Workbooks("Ｂ")
Set WSB = WBB.Worksheets("1")
For i = 100 To 3000 Step 20
Worksheets.Add Before:=Worksheets("Sheet1")
Dim k As String
k = i
ActiveSheet.Name = (k / 100)
Set WSA = WBA.Worksheets(k / 100)
WSB.Range("A1:AY30").Copy Destination:=WSA.Range("A1")
WSA.Range("D4:I30").Clear
WSA.Range("Q4:V30").Clear
WSA.Range("AD4:AI30").Clear
WSA.Range("AQ4:AV30").Clear
Next i
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Sheet2").Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
End Sub
そこで質問ですが、このマクロを作動させると何のエラーの表示もなく最後まで動作は完了します。
ですが、シートの作成は30まで作成できてもその後のセルのコピー＆ペーストはなぜかシート6.8までしかできていません(7～30までのシートはシート作成はできているのですがコピペのみが実行されず空白のままになっています。)
シートもコピペも両方ともシート30まで完了するにはどの点を改善すればいいのでしょうか？
知恵が足りずどうしても直す事が出来ません。
長文申し訳ございませんが是非皆さまのお知恵をお貸しください。
宜しくお願い致します。
Ｅｘｃｅｌのマクロについての質問です。
マクロについての質問です。
以下のようなマクロを作成しました。
このマクロを動作させているのはこのマクロを作成したファイル上です。
Sub Macro9()
Dim WBA As Workbook
Dim WBB As Workbook
Dim WSA As Worksheet
Dim WSB As Worksheet
Set WBA = Workbooks("Ａ")
Set WBB = Workbooks("Ｂ")
Set WSB = WBB.Worksheets("1")
For i = 100 To 3000 Step 20
Worksheets.Add Before:=Worksheets("Sheet1")
Dim k As String
k = i
ActiveSheet.Name = (k / 100)
Set WSA = WBA.Worksheets(k / 100)
WSB.Range("A1:AY30").Copy Destination:=WSA.Range("A1")
WSA.Range("D4:I30").Clear
WSA.Range("Q4:V30").Clear
WSA.Range("AD4:AI30").Clear
WSA.Range("AQ4:AV30").Clear
Next i
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Sheet2").Delete
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("Sheet3").Delete
Application.DisplayAlerts = True
End Sub
そこで質問ですが、このマクロを作動させると何のエラーの表示もなく最後まで動作は完了します。
ですが、シートの作成は30まで作成できてもその後のセルのコピー＆ペーストはなぜかシート6.8までしかできていません(7～30までのシートはシート作成はできているのですがコピペのみが実行されず空白のままになっています。)
シートもコピペも両方ともシート30まで完了するにはどの点を改善すればいいのでしょうか？
知恵が足りずどうしても直す事が出来ません。
長文申し訳ございませんが是非皆さまのお知恵をお貸しください。
宜しくお願い致します。
Execl VBA UserForm1の印刷先を変更したいのですが
Execl VBAで困っています。
UserFormの印刷を条件を変えてプリンター１とプリンター２に振り分けたいのですが
ネットを検索してもいい方法が見つかりません。
UserFormはOSのプリンターを参照するため思うように印刷できません。
一度下記を試しましたが、試通常使うプリンターでしか印刷出来ません
UserFormのプリンター切替方法のご伝授宜しくお願い致します。
===========================================
Sub チェンジプリンター()
Dim myPrinter As String
myPrinter = Application.ActivePrinter '現在のプリンターを記憶
If Worksheets("DeviceRead-Write").Cells(6, 11).Value = 2 Then 'Ｉ６が２ならEPSON_2プリンターに印刷する
Application.ActivePrinter = "EPSON_2 on Ne02:" 'プリンターを切り替える
Range("A4").Value = Application.ActivePrinter 'プリンターの確認
UserForm1.PrintForm 'フォームの印刷
Application.ActivePrinter = myPrinter 'プリンターを元に戻す
Range("A2").Value = Application.ActivePrinter 'プリンターの確認
End If
If Worksheets("DeviceRead-Write").Cells(6, 11).Value = 1 Then 'Ｉ６が２ならEPSON_1プリンターに印刷する
Range("D2").Value = Application.ActivePrinter 'プリンターの確認
UserForm1.PrintForm 'フォームの印刷
End If
End Sub
お世話になります。
現在、Excel VBA（Excel2010）で、Outlook2010を立ち上げて、添付のExcelの表のE列【GL承認日】に日付を入れると、日付書式を確認して、メールが送信されるVBAを作成しています。
そこで、下記のVBAの下の方にある「myMail.Send」でメールが送信されるようになっていて、メールが送信された後、Outlookの【送信済みフォルダ】に送信済みメールが入ります。
その送信済みメールを【送信済みフォルダ】に入ったら、完全に削除するようにしたいのですが、どのようにVBAを追加すれば宜しいでしょうか？
ご存知の方、是非ご教示宜しくお願い致します。
↓該当のExcel VBAです。
----------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myOL As Object
Dim myMail As Object
Dim myBody As String
Dim n As Long
Dim mDate As Variant
On Error Resume Next
'GL承認日の列の日付書式指定
mDate = Array("yyyy/mm/dd")
'GL承認日の該当セルの日付書式を確認
For Each wz In mDate
'GL承認日の該当セルが空白でない場合は以下を処理
If Cells(Target.Row, Target.Column).Value <> "" Then
If InStr(Cells(Target.Row, Target.Column).NumberFormatLocal, wz) > 0 Then
'メールアプリケーションをOutlookに指定
Set myOL = GetObject(, "Outlook.Application")
On Error GoTo 0
If myOL Is Nothing Then
Set myOL = CreateObject("Outlook.Application")
myOL.getnamespace("MAPI").GetDefaultfFolder(6).display
End If
Set myMail = myOL.CreateItem(0)
'B、C行のセル位置を数値で取得
n = Cells(Target.Row, Target.Column).Row
'メール本文
myBody = "振替伝票入力のGL承認が " & Format(Cells(Target.Row, Target.Column).Value, "yyyy/mm/dd") _
& " に完了しました。" & vbNewLine & vbNewLine _
& "●振替伝票No： " & Range("C" & n).Value & vbNewLine & vbNewLine _
& "================================" & vbNewLine _
& " ▲▲部 ××グループ" & vbNewLine _
& "================================"
If Range("B" & n).Value = "ooo" Then
myMail.to = "ooo@***.co.jp"
'ElseIf Range("B" & n).Value = "qqq" Then
' myMail.To = "qqq@***.co.jp"
End If
'メールのタイトル、本文、本文の形式を指定
myMail.Subject = "【振替伝票 GL承認完了通知】"
myMail.Body = myBody
myMail.BodyFormat = 1 'テキスト形式
'メールを送信
myMail.Send
（↑此処でメールが【送信済みフォルダ】に入りますが、このタイミングで【送信済みフォルダ】に入ったメールを完全削除したいです。）
'変数をリセット
Set myMail = Nothing
Set myOL = Nothing
Else
Exit Sub
End If
End If
Next
Exit Sub
End Sub
お世話になります。
マクロ側のソルバー機能を利用して係数を推定しようと考えています。
係数の置き場所はワークシートです。計算値、実測値も同様です。
ただし、ワークシートに打ち出す計算値は外部dllで行います。
コードの概要は以下の通りです。
sub cal
call 外部dll
end
sub optsolver
For i = 1 To 100
Call cal
SolverOk SetCell:="E18", MaxMinVal:=2, ValueOf:="0", ByChange:="D3:D4"
SolverSolve UserFinish:=True
SolverFinish KeepFinal:=1
Next i
end
１回目のステップではワークシート上に計算値が得られるのですが、
２回目以降はセルの値（係数や計算値）が更新されませんし、結果として係数も推定できません。
100回くらい画面がちらついて、終わりの表示もなく終わります。
ここでいう係数と計算値は連動していないとソルバーは使えないと
どこかで聞いたことがあるのですが、このためでしょうか。
（連動って、設定の数値を変えれば自動で追随することだろうとおもいます。）
使用環境は
winxp pro sp2
excel 2003
です。
