ｖｂａです。
Sub tset()
Dim kingaku As Currency
kingaku = 100000
Debug.Print Format(kingaku, "\#,##0")
End Sub
予想としては、「￥100,000」になると思ったし、そうしたかったのですが
#,100000になってしまいます。
どこがおかしいですか？
マクロのセルのオフセットについて質問です。
複数の画像（仮に7枚）を一度に張り付ける際に
If ActiveCell.Column = 1 Then
ActiveCell.Offset(, 8).Select
Else
ActiveCell.Offset(4, -8).Select
End If
このようなマクロ組むと
1 2
3 4
5 6
7
という感じになります。
列は8列空いて、行は4行空くことになると思うのですが
これを
1 2 3
4 5 6
7
としたい場合はどのようなマクロの書き方をすればよいのでしょうか？
ご指導の程宜しくお願いします。マクロを張り付けておきます。
Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
Sub 画像一括貼り付け()
Dim Fname As Variant, fe As Variant
Dim Fn As Variant, Pic As Shape
Dim pno As Long
Dim myFileName As String
Range("A8").Select
SetCurrentDirectory "P:\投レ＋相模原\F-POT KBB42365\外観確認"
Fname = Application.GetOpenFilename _
("jpg,*.jpg,jpeg,*.jpeg,bmp,*.bmp,gif,*.gif,png,*.png", MultiSelect:=True)
If Not IsArray(Fname) Then
MsgBox "取り消されました。", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
pno = 0
For Each Fn In Fname
'この次へ追加すべき行
Selection.Offset(-1, 0) = Mid(Fn, InStrRev(Fn, "\") + 1, Len(Fn) - InStrRev(Fn, "\"))
ActiveCell.Select
Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=Fn, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, Top:=0, Width:=360, Height:=270)
With Pic
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
.Top = ActiveCell.Top ' 位置：アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置：アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
End With
If ActiveCell.Column = 1 Then
ActiveCell.Offset(, 8).Select
Else
ActiveCell.Offset(4, -8).Select
End If
Set Pic = Nothing
pno = pno + 1
Next
Application.ScreenUpdating = True
Range("A1").Select
MsgBox pno & "枚の画像を挿入しました", vbInformation
End Sub
初質問＆VBA初心者のため記述が変なところがあると思いますがご了承ください。
現在changeイベントを使用してイメージした通りに動いてくれている（中身はぐちゃぐちゃですが・・・）のですがこれをすべてのシートでも機能するようにしたいのですが何かいい方法はないでしょうか。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
rc = MsgBox("納車日を更新してもよろしいですか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
MsgBox "納車日を更新しました"
RID = ActiveSheet.Name
Set b = Worksheets("シート名").Cells.Find(What:=RID)
RID_height = Worksheets("シート名").Cells.Find(RID).Row
RID_width = Worksheets("シート名").Cells.Find(RID).Column
ThisWorkbook.Worksheets("シート名").Cells(RID_height, 10).Value = Date
Else
MsgBox "処理を中断します"
End If
End Sub
