目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
1 / 14 ページ 前へ→

【284】Re:今更ながら。
Access  ヒラタ  - 17/6/14(水) 3:03 -

引用なし
パスワード
   ▼Jaka さん:
>誤字だらけやん。
>10年たってから気づきました。
>すみません。
>他にもありそうな気が・・・。
>
>>  PtWd = InputBox("ボタンに持たせる引数(数字のみ)を入力してください。", "引数入力", , XPos:=横位置, YPos:=縦位置)
>>  If PtWd = "" Then
>>    MsgBox "引数なし 終了"
>>    Exit Sub
>>  ElseIf Not IsNumeric(PasWd) Then
>>    MsgBox "数字だけです。 終了"
>>    Exit Sub
>>  End If
> 
>
>ElseIf Not IsNumeric(PasWd) Then
>  ↓
>ElseIf Not IsNumeric(PtWd) Then


ご情報ありがとうございます。


yaplog.jp/hotbags/
・ツリー全体表示

【283】dowhileで複数条件を指定
Excel  山川  - 16/10/23(日) 14:03 -

引用なし
パスワード
   dowhileで複数条件を指定をしても、効きません。

Do While Ws.Cells(I, 5).Value = False And UsrFrmQus.txtFil.Text <> Ws.Cells(I, 1).Value

dowhileではもともと複数条件指定できないのですか?
・ツリー全体表示

【282】入力規則リストにない値が入力できてしまう...
Excel  nanashi  - 15/8/12(水) 11:57 -

引用なし
パスワード
   リストによる入力規則で、「何も選ばない」を可能にするためリスト範囲の先頭に空白セルを含める場合がある。

この時、リスト範囲を入力規則を設定したセルと異なるワークシートにある名前で指定すると、エラー設定をしているにもかかわらず任意の値が入力できてしまう。
Excel 95-2003 形式では他のシートを直接参照する入力規則は利用できなかったため、名前で指定することが多かった。

エラー設定を有効にするには、Excel 2007 以降で =SheetName!Address と指定するか =INDIRECT("範囲の名前") とすればよい。
・ツリー全体表示

【281】今更ながら。
Excel  Jaka  - 15/8/6(木) 12:25 -

引用なし
パスワード
   誤字だらけやん。
10年たってから気づきました。
すみません。
他にもありそうな気が・・・。

>  PtWd = InputBox("ボタンに持たせる引数(数字のみ)を入力してください。", "引数入力", , XPos:=横位置, YPos:=縦位置)
>  If PtWd = "" Then
>    MsgBox "引数なし 終了"
>    Exit Sub
>  ElseIf Not IsNumeric(PasWd) Then
>    MsgBox "数字だけです。 終了"
>    Exit Sub
>  End If


ElseIf Not IsNumeric(PasWd) Then
  ↓
ElseIf Not IsNumeric(PtWd) Then
・ツリー全体表示

【280】両隣のセルにコピーする
Excel  ショウ E-MAIL  - 15/8/1(土) 16:20 -

引用なし
パスワード
   困っています。

VBAで変化させたい表は以下のようになっています。
C   X Y Z
    2 4 4
    3 5 5
計   5 9 3   
    
空欄のC列に計と入力がある場合、計が入力されている同行のX列とZ列のセルに、真ん中のY列にある数字が入力されるようにしたいです。上の場合だと9が両隣に5にコピーされるようにしたいです。
また、この処理を450行目まで繰り返し行えるようにしたいです。

ちなみに考えたVBAは
Sub ()

If Cells(i, "C").Value = "小計(kg)" Then
Cells(i, "X").Value = Cells(i, "Y").Value
Cells(i, "Z").Value = Cells(i, "Y").Value

For i = 1 To 450
Next i
End if
End Sub

このまま起動させると、アプリケーションの定義またはオブジェクションの定義のエラーとなります.

どのように書き換えれば良いでしょうか?
宜しくお願いします。
・ツリー全体表示

【279】accessのパフォーマンスの最適化について
Access  マサリン  - 15/3/6(金) 22:56 -

引用なし
パスワード
   access 2010のパフォーマンスの最適化について教えてください。
パフォーマンスの最適化のフォームを解析中、このプロパティの設定値が値が長すぎます。のエラーが表示されます。
このエラーの解消抱負を教えてください。
・ツリー全体表示

【278】企業名を入れると企業番号が出るようにした...
Access  りぃな  - 15/3/6(金) 8:21 -

引用なし
パスワード
   企業名を入れると企業番号が隣のセルに自動で出るようにしたいんですが、作り方が分りません。
アクセス初心者です。
イチイチコピペしてます。
宜しくお願いします。
解りやすく教えて下さい。
・ツリー全体表示

【277】VBでExcellのSubを走らせることが出来ますか
Excel  Kチャン E-MAIL  - 13/8/15(木) 20:55 -

引用なし
パスワード
   VBでExcellを使ったプログラミングをしていますが、VBでプログラミングする
より、ExcellのVBAが使えたら便利なことがあると思いますが、その様なことが
出来るのでしょうか。お教えください。
 例えば、VBAでExcellのA5:F5列をコピーし、A10:F10にペーストすると言う様な
Sub CopyPaste(本来はもっと複雑なVBAですが。)がSheet2にあったとしたら、
VBでそのSub CopyPasteを指示すれば上記の様なコピー、ペーストが出来るなどです。
 よろしくお教えください。
・ツリー全体表示

【276】テーブル更新について
Access  VBA初心者です E-MAIL  - 11/11/27(日) 20:20 -

引用なし
パスワード
   VBA初心者です。
テーブルAを参照して同じサービス書番号のテーブルB2つのフィールドをテーブルAの内容に更新するクエリを作成したのですが、
「メソッドまたはデータメンバが見つかりません」というエラーになります。
初歩的なことだとは思うのですが、行き詰っております。
どなたか教えていただけませんでしょうか。
よろしくお願いいたします。


Private Sub 使用日更新_Click()

Dim CN As dao.Connection
Dim rsA As dao.Recordset
Dim rsB As dao.Recordset
Set CN = CurrentProject.Connection
rsA.Open "T_使用", CN, adOpenKeyset, adLockOptimistic
rsB.Open "T_サービス書", CN, adOpenKeyset, adLockOptimistic
 Do Until rsA.EOF
   rsB.Filter = " サービス書番号 = '" & rsA!サービス書番号 & "'"
   If rsB.EOF Then
     rsB.AddNew  
     rsB!使用日 = rsA!サービス書使用日
     rsB!使用社員番号 = rsA!使用社員
     rsB.Update
   End If
   rsA.MoveNext
 Loop
rsB.Close: Set rsB = Nothing
rsA.Close: Set rsA = Nothing
CN.Close: Set CN = Nothing


End Sub
・ツリー全体表示

【275】複数ファイルから、対象データの抽出
Excel  VBA初心者  - 11/10/24(月) 10:52 -

引用なし
パスワード
   こんにちは、VBA初心者です。
過去のファイルを管理しやすいように、VBAにて検索&表示画面を作ろうかと思ったんですが、うまくいきません。。
色々なサイトで紹介されているプログラミングを参考に、以下のコードを作成しました。

複数個ある、過去ファイルから条件に合う行をそれぞれ一行ずつコピーして一覧を作成したいのですが、フィルタまではうまく動くのですが、タイトル行を削除しようとするとエラーになります。
(下記プログラムで★の部分)
どうやら原因はtbl.Rows.Count の値が1になっているようなのですが、最後の「 Workbooks(b4Table.Name).Close SaveChanges:=False」をコメントアウトして、ファイルを表示してみるとタイトル行以外にも一行表示されています。。。

VBA上級者の皆様の力を貸して下さい。よろしくお願いします!
ちなみにExcel2007を使ってます。

Sub display()

Dim b4Table As Object
Dim fso As Object
Dim CasNo, Row As Integer
Dim CalNo As String

Set fso = CreateObject("Scripting.FileSystemObject")
Row = 7
Application.ScreenUpdating = False
  
   For Each b4Table In fso.GetFolder(ThisWorkbook.Path & "\before\").Files
  
    CalNo = "A" & Row
    
    Workbooks.Open Filename:=ThisWorkbook.Path & "\before\" & b4Table.Name
    
    If ActiveSheet.AutoFilterMode Then
      ActiveSheet.AutoFilterMode = False
    End If

    Workbooks(b4Table.Name).Worksheets(1).Range("1:500").AutoFilter _
    field:=5, Criteria1:=ThisWorkbook.Worksheets(1).Range("C2")
    Range(CalNo).CurrentRegion.Select
    Set tbl = Range(CalNo).CurrentRegion.SpecialCells(xlCellTypeVisible)
    MsgBox ("tbl.Rows.Count = " & tbl.Rows.Count)

      ★tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
      tbl.Copy ThisWorkbook.Worksheets(1).Range(CalNo)
      tbl.AutoFilter
   
     Workbooks(b4Table.Name).Close SaveChanges:=False
    
    Row = Row + 1
   Next

Application.ScreenUpdating = True

Set fso = Nothing

End Sub
・ツリー全体表示

【274】CSVファイルから16桁以上の数値を取得したい
Excel  初心者  - 11/10/19(水) 12:21 -

引用なし
パスワード
   初めまして。VBA初心者です。
現在、指定した条件をキーにCSVファイルから合致したレコードをexcelに出力するマクロを作成しています。con.Executeを用いています。
CSVファイルの1つのカラムが数値16桁以上になっており、出力した結果値が四捨五入されてしまいます。
四捨五入されないで正確に値を取得する方法はあるのでしょうか?

ご回答頂けると助かります。
・ツリー全体表示

【273】DOS用短いフルパス
Excel  Jaka  - 11/4/28(木) 15:22 -

引用なし
パスワード
   パスが長すぎてエラーになったりするShellなんかに役に立つと思います。

DOS用短いフォルダパス

MsgBox CreateObject("Scripting.FileSystemObject").GetFolder("フォルダパス").ShortPath

DOS用短いファイルパス

MsgBox CreateObject("Scripting.FileSystemObject").GetFile("フルパスファイル名").ShortPath
・ツリー全体表示

【272】Re:inputboxで入力した数値が正しく反映さ...
Excel  Jaka  - 11/3/9(水) 15:08 -

引用なし
パスワード
   Dim i As Double
Dim a As Double

因みに、ここ(目安箱)は質問するところではないです。
・ツリー全体表示

【271】inputboxで入力した数値が正しく反映されな...
Excel  hirobon E-MAIL  - 11/3/6(日) 23:35 -

引用なし
パスワード
   Inputboxでレートを入力し、該当セルに反映させたいのですが、なぜか下記複数インプットボックスがある中で、"a"と、"g"のみなぜか小数点が切り上げされてしまいます。(例) inputobox= \81.135⇒セル=\82.000-など

該当セル確認しましたが、他のセルの書式と全く同じで、なにが原因が検討がつきません.... この件解決策お分かりの方いらっしゃいましたら、お教えいただけますでしょうか???

よろしくお願い致します。

***下記VBA内容載せておきます***
///////////////////////////////////////////////////////////////////////
Sub 3.Aレート記入()

Dim i As Integer
Dim a As Integer

a = Application.InputBox(prompt:="1月レートを入力してください", Type:=1)
b = Application.InputBox(prompt:="2月レートを入力してください", Type:=1)
c = Application.InputBox(prompt:="3月レートを入力してください", Type:=1)
d = Application.InputBox(prompt:="4月レートを入力してください", Type:=1)
e = Application.InputBox(prompt:="5月レートを入力してください", Type:=1)
f = Application.InputBox(prompt:="6月レートを入力してください", Type:=1)
g = Application.InputBox(prompt:="7月レートを入力してください", Type:=1)
h = Application.InputBox(prompt:="8月レートを入力してください", Type:=1)
i = Application.InputBox(prompt:="9月レートを入力してください", Type:=1)
j = Application.InputBox(prompt:="10月レートを入力してください", Type:=1)
k = Application.InputBox(prompt:="11月レートを入力してください", Type:=1)
l = Application.InputBox(prompt:="12月レートを入力してください", Type:=1)

Worksheets("RegionPrice貼り付けシート").Cells(1, 9) = a
Worksheets("RegionPrice貼り付けシート").Cells(1, 11) = b
Worksheets("RegionPrice貼り付けシート").Cells(1, 13) = c
Worksheets("RegionPrice貼り付けシート").Cells(1, 15) = d
Worksheets("RegionPrice貼り付けシート").Cells(1, 17) = e
Worksheets("RegionPrice貼り付けシート").Cells(1, 19) = f
Worksheets("RegionPrice貼り付けシート").Cells(1, 21) = g
Worksheets("RegionPrice貼り付けシート").Cells(1, 23) = h
Worksheets("RegionPrice貼り付けシート").Cells(1, 25) = i
Worksheets("RegionPrice貼り付けシート").Cells(1, 27) = j
Worksheets("RegionPrice貼り付けシート").Cells(1, 29) = k
Worksheets("RegionPrice貼り付けシート").Cells(1, 31) = l

End Sub
//////////////////////////////////////////////////////////////
・ツリー全体表示

【270】動かない原因2.
全般  Jaka  - 11/3/2(水) 15:43 -

引用なし
パスワード
   ExlApp.Run ("'" & OPFL & "'!Auto_Open") 'Auto_Openの場合実行
                     ↑
  Auto_Open")の後のスペースもタブに返還されているから。
・ツリー全体表示

【269】ワードの場合
全般  Jaka  - 11/3/2(水) 11:27 -

引用なし
パスワード
   ワードの場合はね。
ってほとんど変わってない。
掲示板上で、半角スペースがTabに返還されているところは同じ。
修正が必要。

Dim WsArg,WdApp

Set WsArg = WScript.Arguments
If WsArg.Count = 0 Then
  WScript.Echo "このVbsファイルにWordファイルをドラッグ&ドロップしてください。"
  Wscript.Quit
End If

'起動しているワード(アプリ)があるかチェック
On Error Resume Next
Set WdApp = GetObject(, "Word.Application" )
If WdApp Is Nothing Then
  Set WdApp = CreateObject("Word.Application")
End If
On Error Goto 0

WdApp.Visible = True
WdApp.Documents.Open WsArg(0)
CreateObject("WScript.Shell").AppActivate WdApp.Caption
WdApp.WindowState = 0
Set WdApp = Nothing
Set WsArg = Nothing
Wscript.Quit
・ツリー全体表示

【268】VBSファイルにxlsファイルをドラッグ&ドロ...
Excel  Jaka  - 11/3/1(火) 17:18 -

引用なし
パスワード
   下記コードが書かれたVBSファイルにエクセルブックをドラッグ&ドロップすると
エクセルが起動してファイルを開いてくれます。
ただ、下記コードをメモ帳にコピペしても動かないかも。
改行コードの違いか文字コードの違いか解らないけど、以前ここにアップして
試した時は動いてくれなかった。

原因。
>  MsgBox "このVbsファイルに画像ファイルをドラッグ&ドロップしてください。",

この辺など他、半角スペースがタブに返還されているから...。
このタブを消すか半角スペースに直せば動きます。


Dim WsArg,ExlApp

Set WsArg = WScript.Arguments
If WsArg.Count = 0 Then
MsgBox "このVbsファイルにエクセルファイルをドラッグ&ドロップしてください。", vbInformation,"Wクリックエラー。"
Wscript.Quit
End If

'エクセルが起動しているかチェック。
On Error Resume Next
Set ExlApp = GetObject(, "Excel.Application" )
If ExlApp Is Nothing Then
'MsgBox "エクセルが起動していないようなので中止。", vbInformation,"エクセル起動エラー"
'Wscript.Quit
'↓エクセルが起動していなかった場合、起動させたい時。
Set ExlApp = CreateObject("Excel.Application")
End If
On Error Goto 0

OPFL = WsArg(0)
ExlApp.Visible = True
ExlApp.WorkBooks.Open OPFL

CreateObject("WScript.Shell").AppActivate ExlApp.Caption
ExlApp.WindowState = -4143

On Error Resume Next
ExlApp.Run ("'" & OPFL & "'!Auto_Open") 'Auto_Openの場合実行
On Error Goto 0

Set ExlApp = Nothing
・ツリー全体表示

【267】表に位置について。
Excel  Jaka  - 11/2/14(月) 16:59 -

引用なし
パスワード
   上記祝祭日表の位置が気に食わなかったら、1度下記セルに貼り付けてから、
列や行を削除するなり、移動させれば良いです。
参照先も自動で変更されます。

B1
B4〜B29
C4〜C29
・ツリー全体表示

【265】42歳のオジイさんですww
Access  ヨシカズ  - 10/3/25(木) 7:25 -

引用なし
パスワード
   俺みたいなオッサンのイチモツでも、喜んでくれる女性っているもんだな。
SEXの練習相手になっただけで6万円も頂いちゃったよ(^^)
・ツリー全体表示

【264】Re:ちょっと気になる現象6 Shapeオブジェ...
Excel  ichinose  - 10/2/11(木) 20:22 -

引用なし
パスワード
   >アクティブシートに二つの黒く塗りつぶされた見た目はまったく同じの
>オートシェイプの円があります。
>
>以下のような塗りつぶしの色が黒だったら、削除する というコードを実行したところ
>
> Sub test1()
>  Dim c As Shape
>  For Each c In ActiveSheet.Shapes
>    If c.Fill.ForeColor.SchemeColor = 8 Then c.Delete
>   '---------------------------------
>  Next c
> End Sub

上記コードのエラーは、以下のコードで作成された二つのオートシェイプの円に対して
実行すると、発生します。

'=========================================================
Sub サンプル作成()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.SchemeColor = 8
  End With
  With ActiveSheet.Shapes.AddShape(msoShapeOval, rc.Left, rc.Top, rc.Width, rc.Width)
    .Fill.ForeColor.RGB = RGB(0, 0, 0)
  End With
End Sub

同じ黒でもSchemeColorで設定した円とRGB で設定した円、test1は、
RGBで設定した円に対してエラーが発生します。


サンプル作成で作成した円は、以下のコード(test2)だと正常に二つとも削除してくれます。

Sub test2()
  Dim c As Shape
  For Each c In ActiveSheet.Shapes
    If c.Fill.ForeColor.RGB = 0 Then c.Delete
  Next c
End Sub


又、DrawingobjectsのInterior.ColorやColorindexで判断すると
どちらでも(test3 は、Colorindexで判断、test4は、RGBで判断)削除してくれます。

'======================================================
Sub test3()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.ColorIndex = 1 Then c.Delete
  Next c
End Sub
'======================================================
Sub test4()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.Color = 0 Then c.Delete
  Next c
End Sub

こんなところでも古いオブジェクトのほうが安定しています。


ShapeのFill.ForeColor.RGB だと微妙な色の設定ができることは
認めますけどね!!


Sub サンプル作成3()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.RGB = RGB(220, 105, 235)
  End With
  With ActiveSheet.Ovals.Add(rc.Left, rc.Top, rc.Width, rc.Width)
    .Interior.Color = RGB(220, 105, 235)
  End With
End Sub
・ツリー全体表示

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
1 / 14 ページ 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free