Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


21 / 3841 ページ ←次へ | 前へ→

【82068】Re:ユーザー関数(引数・戻り値とも配列)...
質問  popopo  - 22/9/10(土) 2:25 -

引用なし
パスワード
   マナ さん、貴重なヒントありがとうございまうす。

再現できました。C1#が不可は不思議
足掛かりにして、もう少し反応を調べてみます。

=pu(pre(A1,B1)) '{57,0}スピル表示
=pu(C1#)    '#VALUE!
=pu(pre(A1,B1)) '{57,0}スピル表示
=pu(pre(A1,B1)) '{57,0}スピル表示

ユーザー関数では、以下限定の模様ですね
 ・引数はバリアント型
 ・配列はindex=1から
・ツリー全体表示

【82067】Re:ユーザー関数(引数・戻り値とも配列)...
発言  マナ  - 22/9/9(金) 22:26 -

引用なし
パスワード
   ▼popopo さん:

よくわかりませんが、これでエラーにはなりませんでした。

Public Function Pu(p() As Variant) As Long()  '配列受取・配列戻り
  Dim ret() As Long: ReDim ret(1 To UBound(p))
  ret(1) = p(1) + p(2) '和
  ret(2) = p(1) - p(2) '差
  Pu = ret
End Function。
・ツリー全体表示

【82066】ユーザー関数(引数・戻り値とも配列)にE...
質問  popopo E-MAIL  - 22/9/9(金) 17:57 -

引用なし
パスワード
   関数(引数・戻り値とも配列)を
Excelワークシートから配列を渡し、ユーザー関数として呼び出したい。
ご協力下さい。

・VBAコードからは、問題なく利用可能な関数Pu
・Excelワークシートから呼び出し不可。#VALUE!表示

・以下関数で挟み、VBAからは利用可能
 ・Pre_関数(引数:文字列 戻り値:配列)
 ・Post関数(引数:配列  戻り値:文字列)

◎・xPack関数(引数:文字列 戻り値:文字列):パッケージ シートからも利用可能
 種々関数を連結したく、高速化からも、直接呼出す方法はないでしょうか?
 宜しくお願い致します。

準備 A1=12, B1=45
結果
・C1=Pre(A1,B1)  '{12,45}スピル表示
・C2=Pu(Pre(B1,C1) '#VALUE!
・C3=Pu(C1#)    '#VALUE!
・C4=Pu({12,45})  '#VALUE!
・C5=Pu(Pre("12","45")) '#VALUE!

・C11=Post(Pre(A1,B1))  '#VALUE!
・C12=Post(Pu(Pre(B1,C1)))'#VALUE!
・C13=Post(Pu(C1#))    '#VALUE!
・C14=Post(Pu({12,45}))  '#VALUE!
・C15=Post(Pu(Pre("12","45"))) '#VALUE!

・C21=xPack(A1,B1) '-1881 正 パッケージ関数

不具合を再現する単純コード 演算内容は問わず
--
Public Function Pu(p() As Long) As Long() '配列受取・配列戻り
  Dim ret() As Long: ReDim ret(UBound(p))
  ret(0) = p(0) + p(1) '和
  ret(1) = p(0) - p(1) '差
  Pu = ret
End Function

Public Function Pre(S1 As String, S2 As String) As Long()'演算 配列戻り
  Dim ret() As Long: ReDim ret(1)
  ret(0) = CInt(S1)
  ret(1) = CInt(S2)
  Pre = ret
End Function

Public Function Post(p() As Long) As String '加工、戻り値文字列
  Post = p(0) * p(1) '積
End Function

Public Function xPack(S1 As String, S2 As String) As String '引数,戻り値文字列
  xPack = Post(Pu(Pre(S1, S2)))
End Function
---
・ツリー全体表示

【82065】Re:テーブルをやめる
発言  マナ  - 22/9/6(火) 14:35 -

引用なし
パスワード
   ▼りった さん:

>見た目を極力変えずにテーブルをやめるにはどうしたらよいでしょうか?

右クリック/テーブル/範囲に変換
・ツリー全体表示

【82064】テーブルをやめる
質問  りった  - 22/9/6(火) 7:44 -

引用なし
パスワード
   テーブル機能は嫌いです。
ほかの人が作成したファイルを流用した際、表がテーブルになっていることがあります。
見た目を極力変えずにテーブルをやめるにはどうしたらよいでしょうか?
・ツリー全体表示

【82063】Re:PDF 連番保存
発言  OK  - 22/8/31(水) 11:58 -

引用なし
パスワード
   なるべく元コードを生かすようにして書き換えました。

Sub test()
'名前をつけて保存
Dim Desktop_Path As String
Dim fileSaveName As String
Dim fileSaveName_Name As String
Dim fileSavePath As String
Dim kaku As String
Dim ws As Worksheet

 Set ws = ActiveSheet
 kaku = "pdf"
 Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
 fileSaveName = ws.Range("AI1").Value
 fileSaveName_Name = fileSaveName
 fileSavePath = Desktop_Path & "\" & fileSaveName_Name & "." & kaku
 '''保存しようとしたファイル名と既に同じファイル名が存在するならば、
 '''ファイル名の末尾に(i)をつける
 If Dir(fileSavePath) <> "" Then
   k = 0
  Do While Dir(fileSavePath) <> ""
   k = k + 1
   '保存ファイル名を取得
   fileSaveName_Name = fileSaveName & Format(k, "(0)")
   fileSavePath = Desktop_Path & "\" & fileSaveName_Name & "." & kaku
  Loop
 End If
 ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSavePath
 Set ws = Nothing
End Sub
・ツリー全体表示

【82062】Re:PDF 連番保存
発言  はる  - 22/8/31(水) 9:38 -

引用なし
パスワード
   詳細にありがとうございます。
流れを見て修正し、PDF保存まではできたものの、やはり(1)…と追加するところで手詰まりになってしまいます。

Dim k As Integer が抜けていたことが原因かと思ったのですが見当違いでしょうか…。


Dim Desktop_Path As String
Dim k As Integer
'****デスクトップのパス取得
Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")


'''保存しようとしたファイル名と既に同じファイル名が存在するならば、
'''ファイル名の末尾に(i)をつける
If Dir(Desktop_Path) <> "" Then
'保存ファイル名を取得
fileSaveName_name = Dir(Desktop_Path)
'保存先のフォルダを取得
Desktop_Path_path = Replace(fileSaveName, Desktop_Path_name, "")

'保存ファイル名の末尾に(i)をつける
k = 1
Do While Dir(Desktop_Path) <> ""
fileSaveName = Desktop_Path_path & Replace(Desktop_Path_name, ".pdf", "") & "(" & k & ")" & ".pdf"
k = k + 1
Loop
End If
'****アクティブシートをPDFファイルとして保存(デスクトップにA1セルに入力されている名前を付けて保存)
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
End With
・ツリー全体表示

【82061】Re:PDF 連番保存
発言  OK  - 22/8/31(水) 8:58 -

引用なし
パスワード
   はるさんの22/8/30(火) 17:34のコードにコメントを付加してみました。

Dim Desktop_Path As String
'****デスクトップのパス取得
Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
'****アクティブシートをPDFファイルとして保存(デスクトップにA1セルに入力されている名前を付けて保存)
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
End With

'****↓PDFファイルは作成済みなのでその後にファイル名を生成しても無意味。
’またfileSaveNameは変数宣言されてないし、fileSaveNameに何も格納されてないので
'Dir(fileSaveName) の戻り値は必ず""となるので、このIf文はスルーされる
'*****

'''保存しようとしたファイル名と既に同じファイル名が存在するならば、
'''ファイル名の末尾に(i)をつける
If Dir(fileSaveName) <> "" Then
'保存ファイル名を取得
fileSaveName_name = Dir(fileSaveName)
'保存先のフォルダを取得
fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

'保存ファイル名の末尾に(i)をつける
k = 1
Do While Dir(fileSaveName) <> ""
fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".pdf", "") & "(" & k & ")" & ".pdf"
k = k + 1
Loop
End If
・ツリー全体表示

【82060】Re:PDF 連番保存
発言  OK  - 22/8/30(火) 18:10 -

引用なし
パスワード
   考え方です。

PDFのファイルパスを生成する

生成したファイルパスが存在したら存在しなくなるまでループ
する。

PDFを生成したファイルパスで保存する。
・ツリー全体表示

【82059】Re:PDF 連番保存
発言  OK  - 22/8/30(火) 18:03 -

引用なし
パスワード
   PDF作成した後にファイル名を生成しても意味がない
ですよ。
コードをよく見ましょう。
・ツリー全体表示

【82058】Re:PDF 連番保存
発言  はる  - 22/8/30(火) 17:34 -

引用なし
パスワード
   ありがとうございます。参考に作成してみましたが、上書き保存されてしまいます。
初心者で分からないことだらけで申し訳ございません…。


名前をつけて保存
Dim Desktop_Path As String
Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
End With
'''保存しようとしたファイル名と既に同じファイル名が存在するならば、
'''ファイル名の末尾に(i)をつける
If Dir(fileSaveName) <> "" Then
'保存ファイル名を取得
fileSaveName_name = Dir(fileSaveName)
'保存先のフォルダを取得
fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

'保存ファイル名の末尾に(i)をつける
k = 1
Do While Dir(fileSaveName) <> ""
fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".pdf", "") & "(" & k & ")" & ".pdf"
k = k + 1
Loop
End If
・ツリー全体表示

【82057】Re:解決しました。
発言  OK  - 22/8/30(火) 16:22 -

引用なし
パスワード
   今更ですが。
エラー処理で挟む、という方法もあります。

Err.Clear
On Error Resume Next
ActiveSheet.Shapes("Picture 2467").Delete
On Error GoTo 0
・ツリー全体表示

【82056】Re:PDF 連番保存
発言  OK  - 22/8/30(火) 8:53 -

引用なし
パスワード
   参考HPです。

ht tps://qiita.com/yagi_eng/items/cc7570b3878818a8e495
・ツリー全体表示

【82055】Re:PDF 連番保存
発言  OK  - 22/8/30(火) 8:48 -

引用なし
パスワード
   Dir関数の戻り値でファイルの有無の判定ができます。
ファイルパスが既に存在する場合はDo ~ Loopを使って
カウントアップして(1),(2)をファイル名に付加してファイル
パスが存在しなくなるまでループしてファイル名を生成
するようにしてはいかがでしょう?
・ツリー全体表示

【82054】PDF 連番保存
発言  はる  - 22/8/29(月) 17:29 -

引用なし
パスワード
   PDF保存をする際に、同じフォルダ名があると上書き保存されてしまいます。
同じファイルがある場合、〜(1).pdfと、連番で保存していきたいです。

デスクトップに保存までのVBAは書けましたが、連番がどうにもうまくいきません。

ご助言いただけますでしょうか。


'名前をつけて保存
  Dim Desktop_Path As String
  Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
  With ActiveSheet
    .ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
  End With

  Application.DisplayAlerts = True
・ツリー全体表示

【82053】【困っています2】VBA 追加処理の記述を...
質問  坊たん  - 22/8/26(金) 12:51 -

引用なし
パスワード
   追加でVBA 追加処理の記述を教えてください。
お世話になります。マクロの初心者です、稚拙な部分はご容赦ください。
下記マクロを実行すると、メールが送れるようになりましたが
送る前に確認をして送りたいのですが、構文のどの部分に追加で入れる
記述を教えて頂けませんでしょうか。
よろしくお願いいたします。

-----------------------------------------------------------------------------------
SubSample()

DimMacroBAsWorksheet'このブックのシート
DimWb_DataAsWorkbook'1.分割元ブック
DimWb_newAsWorkbook'分割データ保存ブック
DimWsAsString'2.分割元シート名
DimPathAsString'3.分割データ保存先
DimC_GroupAsString'4.グループ対象列
DimGroupNameAsString'グループ名(ブック名)
DimC_CopyAsString'5.コピーデータ右端列
DimYMDAsString'6.保存ブック日付の表示形式
DimPSWAsString'7.読み取りパスワード
DimR_DataAsInteger'データの行番号
DimKoAsInteger'グループの件数

SetMacroB=ThisWorkbook.Worksheets(1)'このブックのシート
SetWb_Data=Workbooks(MacroB.Range("C11").Value)'分割元のブック名
Ws=MacroB.Range("C12")
Path=MacroB.Range("C13")&"\"
C_Group=MacroB.Range("C14")
C_Copy=MacroB.Range("C15")
YMD=MacroB.Range("C16")
PSW=MacroB.Range("C17")

IfYMD=""Then
YMD=""
Else
YMD=Format(Date,YMD)
EndIf

R_Data=2'データの開始行

Application.ScreenUpdating=False
Do
Wb_Data.Activate
Worksheets(Ws).Range(Cells(1,1),Cells(1,C_Copy)).Copy'1行目の項目名コピー
Workbooks.Add
ActiveSheet.PasteRange("A1")'新規ブックに貼り付け
SetWb_new=ActiveWorkbook

Wb_Data.Activate
GroupName=Cells(R_Data,C_Group)
Ko=WorksheetFunction.CountIf(Columns(C_Group),GroupName)'グループの件数を算出

Range(Cells(R_Data,"A"),Cells(R_Data+Ko-1,C_Copy)).Copy'グループ件数分コピー
Wb_new.Activate
ActiveSheet.PasteRange("A2")'新規ブック項目の下に貼り付け
ActiveSheet.Columns.AutoFit
ActiveSheet.UsedRange.Borders.LineStyle=True
Range("D2").Select
ActiveWindow.FreezePanes=True
DimmynameAsString'条件不明
IfActiveSheet.Range("A2")<>""Then
myname=ActiveSheet.Range("A2")
EndIf

Wb_new.SaveAsFilename:=Path&GroupName&"注残納期回答依頼リスト"&YMD&".xlsx",_
Password:=PSW'指定したフォルダーに保存
Wb_new.Close

R_Data=R_Data+Ko

LoopWhileCells(R_Data,C_Group)<>""

MsgBox"完了!"

Application.ScreenUpdating=True

EndSub
・ツリー全体表示

【82052】Re:元々のシートに画像があり、追加した...
発言  マナ  - 22/7/11(月) 19:13 -

引用なし
パスワード
   ▼初心者 さん:

ht tps://www.excel.studio-kazu.jp/kw/20220707141218.html
・ツリー全体表示

【82051】元々のシートに画像があり、追加した複数...
質問  初心者  - 22/7/7(木) 17:48 -

引用なし
パスワード
   教えて下さい。
下記の1回目で画像を複数枚 整列させています。
次に、そのシートに追加画像をいれたとき
挿入→画像で、複数枚の画像を追加し 1回目を実行すると
シート内すべての画像が対象となるので、以前に一部の画像を
上下入れ替えていた場合にも、元に戻ってしまいます。
そこで、
1回目 下記記載で整列
2回目以降 今選択している追加画像のみを整列
というように2種類コマンドボタンを作成したいのですが
2回目以降の設定がうまくいきません。
画像を追加した際に、複数枚選択されてる状態で
2回目以降を実行したら
追加画像のみ、画像サイズが変更されて、以前はりつけていた
既存画像の最後の画像の下から、順番に並んでいくように
ならないでしょうか。よろしくお願い致します。
Private Sub 1回目_Click()
 Dim shp As Shape
 Dim myRng As Range
 Dim myC As New Collection
 Dim c As Object
 For Each shp In ActiveSheet.Shapes
  If shp.Type = msoPicture Then
  If shp.Height = 288 And shp.Width = 336 Then
   If myRng Is Nothing Then Set myRng = shp.TopLeftCell
   If myRng.Row < shp.TopLeftCell.Row Then
    Set myRng = shp.TopLeftCell
   End If
  Else
   myC.Add shp
  End If
  End If
 Next shp
 For Each c In myC
  If myRng Is Nothing Then
   Set myRng = ActiveSheet.Range("C6")
  Else
   Set myRng = myRng.Offset(18)
  End If
  c.LockAspectRatio = msoTrue
  c.Height = 288#
  c.Width = 336#
  c.Top = myRng.Top
  c.left = myRng.left
 Next c
 End Sub
Private Sub 2回目以降_Click()
・ツリー全体表示

【82050】Re:PDF出力した際のファイル名につきまし...
お礼  hamil  - 22/6/23(木) 23:29 -

引用なし
パスワード
   ▼マナ さん:
>▼hamil さん:
>
>Dim 管理番号 As Long
>
>これだと、管理番号は整数という意味になるので
>「予備01」のような文字列を代入しようとしてエラーになったのです。

マナさん

そうだったんですね。。
本当にありがとうございました!!
・ツリー全体表示

【82049】Re:PDF出力した際のファイル名につきまし...
発言  マナ  - 22/6/23(木) 22:28 -

引用なし
パスワード
   ▼hamil さん:

Dim 管理番号 As Long

これだと、管理番号は整数という意味になるので
「予備01」のような文字列を代入しようとしてエラーになったのです。
・ツリー全体表示

21 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free